diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 93aaf87..f22b477 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -1,29 +1,52 @@ -name: C/C++ CI +name: Build and test -on: [push, pull_request] +on: + push: + pull_request: + workflow_dispatch: jobs: - build: + build-test: + name: ${{ matrix.environment }} runs-on: ubuntu-latest - + strategy: + fail-fast: false + matrix: + # default: linked against conda-forge libraries; static: no runtime dependencies + environment: [default, static] steps: - - uses: actions/checkout@v3 + - uses: actions/checkout@v4 + + - uses: prefix-dev/setup-pixi@v0.11.3 + with: + pixi-version: v0.84.1 + environments: ${{ matrix.environment }} + cache: true + cache-write: ${{ github.event_name == 'push' && github.ref_name == 'master' }} - - name: Set up C++ and Fortran - run: | - sudo apt-get update - sudo apt-get install -y g++ gfortran make cmake + # Installing the environment builds the package from source. + - name: Test the examples + run: pixi run -e ${{ matrix.environment }} test - - name: Install OpenBLAS - run: sudo apt-get install -y libopenblas-dev + - name: Check that the executables are static + if: matrix.environment == 'static' + run: | + for exe in .pixi/envs/static/bin/mess*; do + if ldd "$exe"; then echo "$exe is dynamically linked"; exit 1; fi + done - - name: Configure CMake - run: | - mkdir build - cd build - cmake .. -DUSE_SYSTEM_LIBS=ON + - name: Upload the static executables + if: matrix.environment == 'static' + uses: actions/upload-artifact@v4 + with: + name: mess-static-linux-64 + path: .pixi/envs/static/bin/mess* - - name: Build Project - run: | - cd build - make -j2 # Using 2 cores for the CI build \ No newline at end of file + - name: Upload mess-static to the Auto-Mech channel + if: matrix.environment == 'static' && github.event_name == 'push' && github.ref_name == 'master' && github.repository_owner == 'Auto-Mech' + run: | + pixi publish --path static --target-dir dist + # As before: an upload of an existing version fails, which is not an error here + pixi exec rattler-build upload anaconda -o Auto-Mech dist/*.conda || true + env: + ANACONDA_API_KEY: ${{ secrets.ANACONDA_API_KEY }} diff --git a/.github/workflows/static-build.yml b/.github/workflows/static-build.yml deleted file mode 100644 index c7ff067..0000000 --- a/.github/workflows/static-build.yml +++ /dev/null @@ -1,31 +0,0 @@ -name: Build and Upload MESS-Static - -on: - push: - pull_request: - workflow_dispatch: - -jobs: - build: - runs-on: ubuntu-latest - steps: - - name: Checkout the code - uses: actions/checkout@v4 - - - name: Set up Pixi - uses: prefix-dev/setup-pixi@v0.8.9 - with: - manifest-path: static/pixi.toml - - # Build - - name: Build - run: pixi build - working-directory: static/ - - # Upload - - name: Upload - if: ${{ github.ref == 'refs/heads/master' && github.repository_owner == 'Auto-Mech'}} - run: pixi run upload || true - working-directory: static/ - env: - ANACONDA_API_KEY: ${{ secrets.ANACONDA_API_KEY }} \ No newline at end of file diff --git a/.gitignore b/.gitignore index a68f47b..0f1f7ed 100644 --- a/.gitignore +++ b/.gitignore @@ -64,3 +64,6 @@ output/ # Other test-examples/ *.conda + +# Reference outputs for tests/run-examples.sh +!tests/reference/* diff --git a/CMakeLists.txt b/CMakeLists.txt index 5f6349e..3403c33 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -1,464 +1,87 @@ -project(MESS C CXX) -cmake_minimum_required(VERSION 3.16) +cmake_minimum_required(VERSION 3.22) +project(MESS LANGUAGES C CXX Fortran) set(CMAKE_CXX_STANDARD 11) set(CMAKE_CXX_STANDARD_REQUIRED ON) -set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS}") -set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS}") -set(CMAKE_EXE_LINKER_FLAGS "${CMAKE_EXE_LINKER_FLAGS}") -# Options for automatic dependency handling -option(AUTO_DOWNLOAD_DEPENDENCIES "Automatically download and build missing dependencies" ON) -option(USE_SYSTEM_LIBS "Try to use system libraries before downloading" ON) - -# Directory for downloaded and built dependencies -set(EXTERNAL_INSTALL_LOCATION ${CMAKE_BINARY_DIR}/external) -include(ExternalProject) - -# External library URLs and versions -set(OPENBLAS_GIT_URL "https://github.com/OpenMathLib/OpenBLAS.git") -set(OPENBLAS_VERSION "v0.3.21") -set(SLATEC_URL "https://www.netlib.org/slatec/slatec_src.tgz") -set(GSL_URL "https://ftp.gnu.org/gnu/gsl/gsl-2.7.tar.gz") -set(QD_URL "https://www.davidhbailey.com/dhbsoftware/qd-2.3.23.tar.gz") -set(QD_SHA256 "b3eaf41ce413ec08f348ee73e606bd3ff9203e411c377c3c0467f89acf69ee26") - -# Check for direct SLATEC build -if(USE_DIRECT_SLATEC) - message(STATUS "Using direct SLATEC build") - if(EXISTS "${CMAKE_SOURCE_DIR}/external/lib/libslatec.a") - set(SLATEC "${CMAKE_SOURCE_DIR}/external/lib/libslatec.a") - message(STATUS "Found direct SLATEC: ${SLATEC}") - else() - message(WARNING "Direct SLATEC build enabled but library not found. Please run ./slatec_direct.sh first.") - message(STATUS "Falling back to regular SLATEC build") - set(USE_DIRECT_SLATEC OFF) - endif() -endif() - -# Function to conditionally download and build a dependency -function(handle_dependency name) - if(NOT ${name}_FOUND AND AUTO_DOWNLOAD_DEPENDENCIES) - message(STATUS "Will download and build ${name}") - set(${name}_FOUND TRUE PARENT_SCOPE) - set(${name}_DOWNLOADED TRUE PARENT_SCOPE) - endif() -endfunction() - -# Find BLAS and LAPACK -if(USE_SYSTEM_LIBS) - find_package(BLAS QUIET) - find_package(LAPACK QUIET) -else() - set(BLAS_FOUND FALSE) - set(LAPACK_FOUND FALSE) -endif() - -# If BLAS/LAPACK not found, use OpenBLAS which provides both -if((NOT BLAS_FOUND OR NOT LAPACK_FOUND) AND AUTO_DOWNLOAD_DEPENDENCIES) - message(STATUS "BLAS or LAPACK not found. Will download and build OpenBLAS.") - set(BLAS_FOUND TRUE) - set(LAPACK_FOUND TRUE) - - ExternalProject_Add( - openblas - GIT_REPOSITORY ${OPENBLAS_GIT_URL} - GIT_TAG ${OPENBLAS_VERSION} - CMAKE_ARGS -DCMAKE_INSTALL_PREFIX=${EXTERNAL_INSTALL_LOCATION} -DCMAKE_C_FLAGS="-Wno-misleading-indentation" - BUILD_COMMAND $(MAKE) - INSTALL_COMMAND $(MAKE) PREFIX=${EXTERNAL_INSTALL_LOCATION} install - ) - - set(BLAS_LIBRARIES ${EXTERNAL_INSTALL_LOCATION}/lib/libopenblas.so) - set(LAPACK_LIBRARIES ${EXTERNAL_INSTALL_LOCATION}/lib/libopenblas.so) - set(OPENBLAS_DOWNLOADED TRUE) -else() - message(STATUS "Found BLAS: ${BLAS_LIBRARIES}") - message(STATUS "Found LAPACK: ${LAPACK_LIBRARIES}") -endif() - -# Find Fortran compilation capabilities -# This tells CMake to enable Fortran language for our project -enable_language(Fortran OPTIONAL) - -# Find SLATEC -if(USE_SYSTEM_LIBS) - find_library(SLATEC NAMES slatec libslatec QUIET) -endif() - -if(NOT SLATEC AND AUTO_DOWNLOAD_DEPENDENCIES) - message(STATUS "SLATEC not found. Will download and build it.") - - # Create SLATEC wrapper file content for missing C interfaces - file(WRITE ${CMAKE_BINARY_DIR}/slatec_wrapper.f " -! Explicit wrapper for SLATEC functions that need C-compatible interfaces - subroutine davint(x, y, n, xlo, xup, ans, ierr) - implicit none - integer n, ierr - double precision x(n), y(n), xlo, xup, ans - call davint_(x, y, n, xlo, xup, ans, ierr) - return - end - - subroutine ddeabm(f, neq, t, y, tout, info, rtol, atol, idid, - & rwork, lrw, iwork, liw, rpar, ipar) - external f - integer neq, info(*), idid, lrw, iwork(*), liw - double precision t, y(*), tout, rtol(*), atol(*), rwork(*) - integer ipar(*) - double precision rpar(*) - call ddeabm_(f, neq, t, y, tout, info, rtol, atol, idid, - & rwork, lrw, iwork, liw, rpar, ipar) - return - end - - subroutine dbint4(x, y, n, ibcl, ibcr, fbcl, fbcr, kntopt, t, nc, - & bc, ws, lws, ierr) - integer n, ibcl, ibcr, kntopt, nc, lws, ierr - double precision x(*), y(*), fbcl, fbcr, t(*), bc(*), ws(*) - call dbint4_(x, y, n, ibcl, ibcr, fbcl, fbcr, kntopt, t, nc, - & bc, ws, lws, ierr) - return - end - - function dbvalu(t, a, n, k, ideriv, x, inbv, work) - integer n, k, ideriv, inbv - double precision t(*), a(*), x, work(*), dbvalu - dbvalu = dbvalu_(t, a, n, k, ideriv, x, inbv, work) - return - end -") - - # Create build script for SLATEC - file(WRITE ${CMAKE_BINARY_DIR}/build_slatec.sh "#!/bin/sh -set -e -# Use gfortran as default Fortran compiler if not specified -FC=${CMAKE_Fortran_COMPILER} -if [ -z \"$FC\" ]; then - FC=gfortran -fi -FFLAGS='-O2 -fPIC -fdefault-real-8 -fdefault-double-8 -std=legacy' -AR=ar - -echo 'Compiling SLATEC modules...' -for f in *.f; do - echo \"Compiling $f...\" - $FC $FFLAGS -c $f || exit 1 -done - -echo 'Creating library...' -$AR rcs libslatec.a *.o -echo 'Build complete' -") - - # Set up SLATEC build with more detailed configuration for reproducibility - set(SLATEC_SOURCE_DIR ${CMAKE_BINARY_DIR}/slatec_src) - set(SLATEC_BUILD_DIR ${CMAKE_BINARY_DIR}/slatec_build) - - include(ExternalProject) - ExternalProject_Add( - slatec_external - URL ${SLATEC_URL} - DOWNLOAD_DIR ${CMAKE_BINARY_DIR}/downloads - SOURCE_DIR ${SLATEC_SOURCE_DIR} - BINARY_DIR ${SLATEC_BUILD_DIR} - # Configure step - create a simpler setup - CONFIGURE_COMMAND ${CMAKE_COMMAND} -E copy_directory ${SLATEC_SOURCE_DIR} ${SLATEC_BUILD_DIR} - # Copy wrapper file - COMMAND ${CMAKE_COMMAND} -E copy_if_different - ${CMAKE_BINARY_DIR}/slatec_wrapper.f ${SLATEC_BUILD_DIR}/ - # Copy build script - COMMAND ${CMAKE_COMMAND} -E copy_if_different - ${CMAKE_BINARY_DIR}/build_slatec.sh ${SLATEC_BUILD_DIR}/ - # Make build script executable - COMMAND chmod +x ${SLATEC_BUILD_DIR}/build_slatec.sh - # Build step - run the build script - BUILD_COMMAND ${SLATEC_BUILD_DIR}/build_slatec.sh - # Install step - copy built library - INSTALL_COMMAND ${CMAKE_COMMAND} -E copy_if_different - ${SLATEC_BUILD_DIR}/libslatec.a ${EXTERNAL_INSTALL_LOCATION}/lib/libslatec.a - # Disable updates - UPDATE_COMMAND "" - # Logging - LOG_DOWNLOAD ON - LOG_CONFIGURE ON - LOG_BUILD ON - LOG_INSTALL ON - ) - - set(SLATEC ${EXTERNAL_INSTALL_LOCATION}/lib/libslatec.a) - set(SLATEC_DOWNLOADED TRUE) -else() - message(STATUS "Found SLATEC: ${SLATEC}") -endif() - -# Find Fortran libraries needed for SLATEC -# Try to find Intel Fortran runtime -find_library(IFORT_LIBRARY NAMES - ifcore ifport ifcoremt ifportmt - PATHS - /opt/aurora/24.347.0/oneapi/compiler/latest/lib - /opt/aurora/24.347.0/oneapi/compiler/latest/lib/intel64 - /opt/intel/oneapi/compiler/latest/lib - /opt/intel/oneapi/compiler/latest/lib/intel64 +# Options +option(MESS_STATIC "Build fully static executables" OFF) +set(MESS_BLAS_SUFFIX "" CACHE STRING + "Symbol suffix of the ILP64 BLAS/LAPACK library (64_ for OpenBLAS built with SYMBOLSUFFIX=64_)") + +if(MESS_STATIC) + set(CMAKE_FIND_LIBRARY_SUFFIXES .a) + set(BLA_STATIC ON) + add_link_options(-static) +endif() + +# Dependencies +# MESS passes 64-bit integers to BLAS/LAPACK. For a library that FindBLAS cannot +# find by itself (e.g. libopenblas64_), pass -DBLAS_LIBRARIES and -DLAPACK_LIBRARIES. +set(BLA_SIZEOF_INTEGER 8) +find_package(BLAS REQUIRED) +find_package(LAPACK REQUIRED) +find_package(GSL REQUIRED) +find_package(OpenMP REQUIRED) + +# SLATEC (vendored subset, default 32-bit Fortran integers) +file(GLOB SLATEC_SOURCES CONFIGURE_DEPENDS external/SLATEC/src/*.f) +add_library(slatec STATIC ${SLATEC_SOURCES}) + +# MESS library +add_library(messlibs STATIC + src/libmess/atom.cc + src/libmess/configuration.cc + src/libmess/crossrate.cc + src/libmess/d3.cc + src/libmess/divsur.cc + src/libmess/dynamic.cc + src/libmess/dynlib.cc + src/libmess/graph_common.cc + src/libmess/graph_omp.cc + src/libmess/io.cc + src/libmess/key.cc + src/libmess/lapack.cc + src/libmess/limits.cc + src/libmess/linpack.cc + src/libmess/logical.cc + src/libmess/math.cc + src/libmess/mess.cc + src/libmess/model.cc + src/libmess/monom.cc + src/libmess/mpack.cc + src/libmess/multindex.cc + src/libmess/permutation.cc + src/libmess/potential.cc + src/libmess/random.cc + src/libmess/read.cc + src/libmess/slatec.cc + src/libmess/structure.cc + src/libmess/symmetry.cc + src/libmess/system.cc + src/libmess/trajectory.cc + src/libmess/units.cc ) - -if(IFORT_LIBRARY) - message(STATUS "Found Intel Fortran runtime: ${IFORT_LIBRARY}") - set(FORTRAN_LIBRARIES ${IFORT_LIBRARY}) -else() - message(WARNING "Intel Fortran runtime not found, will try gfortran") - # Fall back to gfortran if Intel runtime not found - find_library(GFORTRAN_LIBRARY NAMES - gfortran libgfortran libgfortran.so.5 libgfortran.so.4 libgfortran.so.3 - PATHS - /usr/lib - /usr/lib64 - /usr/lib/gcc - /usr/local/lib - /usr/local/lib64 - /usr/lib/x86_64-linux-gnu - /lib/x86_64-linux-gnu - PATH_SUFFIXES gcc/x86_64-linux-gnu/10 gcc/x86_64-linux-gnu/9 gcc/x86_64-linux-gnu/8 gcc/x86_64-linux-gnu/7 - ) - if(GFORTRAN_LIBRARY) - message(STATUS "Found gfortran: ${GFORTRAN_LIBRARY}") - set(FORTRAN_LIBRARIES ${GFORTRAN_LIBRARY}) - else() - message(FATAL_ERROR "No Fortran runtime found") - endif() -endif() - -# Find optional quadmath library (often needed with gfortran) -find_library(QUADMATH_LIBRARY NAMES quadmath) -if(QUADMATH_LIBRARY) - message(STATUS "Found quadmath: ${QUADMATH_LIBRARY}") - list(APPEND FORTRAN_LIBRARIES ${QUADMATH_LIBRARY}) -endif() - -# Set up link libraries for SLATEC -set(FORTRAN_LIBRARIES ${FORTRAN_LIBRARIES}) - -# Find GSL -if(USE_SYSTEM_LIBS) - find_package(GSL QUIET) -endif() - -if(NOT GSL_FOUND AND AUTO_DOWNLOAD_DEPENDENCIES) - message(STATUS "GSL not found. Will download and build it.") - ExternalProject_Add( - gsl_external - URL ${GSL_URL} - CONFIGURE_COMMAND /configure --prefix=${EXTERNAL_INSTALL_LOCATION} - BUILD_COMMAND make - INSTALL_COMMAND make install - ) - set(GSL_INCLUDE_DIRS ${EXTERNAL_INSTALL_LOCATION}/include) - set(GSL_LIBRARIES ${EXTERNAL_INSTALL_LOCATION}/lib/libgsl.so) - include_directories(${GSL_INCLUDE_DIRS}) - set(GSL_DOWNLOADED TRUE) - set(GSL_FOUND TRUE) -else() - message(STATUS "Found GSL: ${GSL_LIBRARIES}") -endif() - -# Find QD -if(USE_SYSTEM_LIBS) - find_library(QD NAMES qd libqd libqd.a QUIET) -endif() - -if(NOT QD AND AUTO_DOWNLOAD_DEPENDENCIES) - message(STATUS "QD not found. Will download and build it.") - ExternalProject_Add( - qd_external - URL ${QD_URL} - URL_HASH SHA256=${QD_SHA256} - CONFIGURE_COMMAND /configure --prefix=${EXTERNAL_INSTALL_LOCATION} - BUILD_COMMAND make - INSTALL_COMMAND make install - ) - set(QD ${EXTERNAL_INSTALL_LOCATION}/lib/libqd.a) - set(QD_DOWNLOADED TRUE) -else() - message(STATUS "Found QD: ${QD}") -endif() - -# Create a list of dependencies we need to add -set(DEPENDENCIES_TARGETS "") -if(DEFINED OPENBLAS_DOWNLOADED) - list(APPEND DEPENDENCIES_TARGETS openblas) -endif() -if(DEFINED SLATEC_DOWNLOADED) - list(APPEND DEPENDENCIES_TARGETS slatec_external) -endif() -if(DEFINED GSL_DOWNLOADED) - list(APPEND DEPENDENCIES_TARGETS gsl_external) -endif() -if(DEFINED QD_DOWNLOADED) - list(APPEND DEPENDENCIES_TARGETS qd_external) -endif() - -# Set up include directories for downloaded libraries -include_directories(${EXTERNAL_INSTALL_LOCATION}/include) -link_directories(${EXTERNAL_INSTALL_LOCATION}/lib) - -# Define the library -add_library(messlibs - ${PROJECT_SOURCE_DIR}/src/libmess/atom.cc - ${PROJECT_SOURCE_DIR}/src/libmess/io.cc - ${PROJECT_SOURCE_DIR}/src/libmess/limits.cc - ${PROJECT_SOURCE_DIR}/src/libmess/math.cc - ${PROJECT_SOURCE_DIR}/src/libmess/symmetry.cc - ${PROJECT_SOURCE_DIR}/src/libmess/d3.cc - ${PROJECT_SOURCE_DIR}/src/libmess/key.cc - ${PROJECT_SOURCE_DIR}/src/libmess/mess.cc - ${PROJECT_SOURCE_DIR}/src/libmess/multindex.cc - ${PROJECT_SOURCE_DIR}/src/libmess/units.cc - ${PROJECT_SOURCE_DIR}/src/libmess/graph_common.cc - ${PROJECT_SOURCE_DIR}/src/libmess/lapack.cc - ${PROJECT_SOURCE_DIR}/src/libmess/mpack.cc - # ${PROJECT_SOURCE_DIR}/src/libmess/mpack_dd.cc - ${PROJECT_SOURCE_DIR}/src/libmess/permutation.cc - ${PROJECT_SOURCE_DIR}/src/libmess/graph_omp.cc - ${PROJECT_SOURCE_DIR}/src/libmess/linpack.cc - ${PROJECT_SOURCE_DIR}/src/libmess/model.cc - ${PROJECT_SOURCE_DIR}/src/libmess/slatec.cc - ${PROJECT_SOURCE_DIR}/src/libmess/crossrate.cc - ${PROJECT_SOURCE_DIR}/src/libmess/random.cc - ${PROJECT_SOURCE_DIR}/src/libmess/read.cc - ${PROJECT_SOURCE_DIR}/src/libmess/divsur.cc - ${PROJECT_SOURCE_DIR}/src/libmess/dynamic.cc - ${PROJECT_SOURCE_DIR}/src/libmess/structure.cc - ${PROJECT_SOURCE_DIR}/src/libmess/configuration.cc - ${PROJECT_SOURCE_DIR}/src/libmess/dynlib.cc - ${PROJECT_SOURCE_DIR}/src/libmess/monom.cc - ${PROJECT_SOURCE_DIR}/src/libmess/logical.cc - ${PROJECT_SOURCE_DIR}/src/libmess/potential.cc - ${PROJECT_SOURCE_DIR}/src/libmess/system.cc - ${PROJECT_SOURCE_DIR}/src/libmess/trajectory.cc) - -# Add dependency on external libraries if needed -if(DEPENDENCIES_TARGETS) - add_dependencies(messlibs ${DEPENDENCIES_TARGETS}) -endif() - -# Set Fortran-compatible flags for C/C++ code -set_target_properties(messlibs PROPERTIES - COMPILE_FLAGS "-fPIC -fno-strict-aliasing" -) - -# Set up executables -add_executable(mess ${PROJECT_SOURCE_DIR}/src/mess_driver.cc) -add_executable(messpf ${PROJECT_SOURCE_DIR}/src/partition_function.cc) -add_executable(messabs ${PROJECT_SOURCE_DIR}/src/abstraction.cc) -add_executable(messsym ${PROJECT_SOURCE_DIR}/src/symmetry_number.cc) - -# Link libraries -target_link_libraries(mess - messlibs - ${BLAS_LIBRARIES} - ${LAPACK_LIBRARIES} - ${GSL_LIBRARIES} - ${QD} - -Wl,--start-group # Use link groups to handle circular dependencies - ${SLATEC} - ${FORTRAN_LIBRARIES} - -lm # Math library - -Wl,--end-group - ${CMAKE_DL_LIBS} -) -target_link_libraries(messpf - messlibs - ${BLAS_LIBRARIES} - ${LAPACK_LIBRARIES} - ${GSL_LIBRARIES} - ${QD} - -Wl,--start-group - ${SLATEC} - ${FORTRAN_LIBRARIES} - -lm - -Wl,--end-group - ${CMAKE_DL_LIBS} -) -target_link_libraries(messabs - messlibs - ${BLAS_LIBRARIES} - ${LAPACK_LIBRARIES} - ${GSL_LIBRARIES} - ${QD} - -Wl,--start-group - ${SLATEC} - ${FORTRAN_LIBRARIES} - -lm - -Wl,--end-group - ${CMAKE_DL_LIBS} -) -target_link_libraries(messsym - messlibs - ${BLAS_LIBRARIES} - ${LAPACK_LIBRARIES} - ${GSL_LIBRARIES} - ${QD} - -Wl,--start-group - ${SLATEC} - ${FORTRAN_LIBRARIES} - -lm - -Wl,--end-group - ${CMAKE_DL_LIBS} -) - -install(TARGETS mess DESTINATION bin) -install(TARGETS messpf DESTINATION bin) -install(TARGETS messabs DESTINATION bin) -install(TARGETS messsym DESTINATION bin) - -# Create a direct wrapper for missing SLATEC functions -file(WRITE ${CMAKE_BINARY_DIR}/slatec_wrapper.f " - subroutine davint(x, y, n, xlo, xup, ans, ierr) - implicit none - integer n, ierr - double precision x(n), y(n), xlo, xup, ans - call davint_(x, y, n, xlo, xup, ans, ierr) - return - end - - subroutine ddeabm(f, neq, t, y, tout, info, rtol, atol, idid, - & rwork, lrw, iwork, liw, rpar, ipar) - external f - integer neq, info(*), idid, lrw, iwork(*), liw - double precision t, y(*), tout, rtol(*), atol(*), rwork(*) - integer ipar(*) - double precision rpar(*) - call ddeabm_(f, neq, t, y, tout, info, rtol, atol, idid, - & rwork, lrw, iwork, liw, rpar, ipar) - return - end - - subroutine dbint4(x, y, n, ibcl, ibcr, fbcl, fbcr, kntopt, t, nc, - & bc, ws, lws, ierr) - integer n, ibcl, ibcr, kntopt, nc, lws, ierr - double precision x(*), y(*), fbcl, fbcr, t(*), bc(*), ws(*) - call dbint4_(x, y, n, ibcl, ibcr, fbcl, fbcr, kntopt, t, nc, - & bc, ws, lws, ierr) - return - end - - function dbvalu(t, a, n, k, ideriv, x, inbv, work) - integer n, k, ideriv, inbv - double precision t(*), a(*), x, work(*), dbvalu - dbvalu = dbvalu_(t, a, n, k, ideriv, x, inbv, work) - return - end -") - -# Compile the SLATEC wrapper -add_custom_command( - OUTPUT ${CMAKE_BINARY_DIR}/slatec_wrapper.o - COMMAND gfortran -c -O2 -fPIC ${CMAKE_BINARY_DIR}/slatec_wrapper.f -o ${CMAKE_BINARY_DIR}/slatec_wrapper.o - DEPENDS ${CMAKE_BINARY_DIR}/slatec_wrapper.f - COMMENT "Compiling SLATEC wrapper" -) - -# Create a custom target for the wrapper -add_custom_target(slatec_wrapper DEPENDS ${CMAKE_BINARY_DIR}/slatec_wrapper.o) -add_dependencies(messlibs slatec_wrapper) +target_include_directories(messlibs PUBLIC src/libmess) +target_link_libraries(messlibs PUBLIC + slatec LAPACK::LAPACK BLAS::BLAS GSL::gsl OpenMP::OpenMP_CXX ${CMAKE_DL_LIBS}) + +# Rename the BLAS/LAPACK routines MESS calls (dgemm_ -> dgemm_64_, ...) +if(MESS_BLAS_SUFFIX) + foreach(f IN ITEMS + dgelsd dgemv dgesdd dgesv dgetrf dgetri dgetrs dppsv dpptrf dpptri dpptrs + dsbevd dspgvd dspmv dspsv dsptrf dsptri dsptrs dsyev dsyevd zgemm zhpev zhpgvd) + target_compile_definitions(messlibs PUBLIC ${f}_=${f}_${MESS_BLAS_SUFFIX}) + endforeach() +endif() + +# Executables +add_executable(mess src/mess_driver.cc) +add_executable(messpf src/partition_function.cc) +add_executable(messabs src/abstraction.cc) +foreach(exe IN ITEMS mess messpf messabs) + target_link_libraries(${exe} PRIVATE messlibs) +endforeach() + +include(GNUInstallDirs) +install(TARGETS mess messpf messabs) diff --git a/README.md b/README.md index 73452a2..6297062 100644 --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ -[![C/C++ CI](https://github.com/keceli/MESS/actions/workflows/build.yml/badge.svg)](https://github.com/keceli/MESS/actions/workflows/build.yml) +[![Build and test](https://github.com/Auto-Mech/MESS/actions/workflows/build.yml/badge.svg)](https://github.com/Auto-Mech/MESS/actions/workflows/build.yml) # MESS @@ -7,122 +7,41 @@ Master Equation System Solver The primary purpose of the program is to calculate temperature and pressure dependent rate coefficients for complex-forming reactions via solution of the one-dimensional master equation. Ancillary calculations of various quantities (e.g., stabilization probabilities for microcanonical initial distributions, microcanonical rate constants, partition functions, and related thermochemical information, time dependent propagation of species populations, etc.) are also available. -### Requirements ### +## Installation -To build MESS, the following libraries are required: -BLAS -LAPACK -SLATEC -MPACK - - -### Direct Installation using Conda - -The most direct way to install the code is through the conda package manager. -If you have conda installed, -(1) activate an environment in you wish to use to install MESS, and -(2) run the install command: +The Auto-Mech channel provides fully static executables that run on any x86-64 Linux, with no runtime dependencies: ``` -conda install -c auto-mech mess +conda install -c auto-mech mess-static ``` +They are also attached to each run of the GitHub Actions workflow (artifact `mess-static-linux-64`). -If you do not have a preferred Conda environment set up, an empty environment with no packages can be created and activated with the following commands -``` -conda create --name myenv -conda activate myenv -``` -where `myenv` should be replaced with your preferred name for the environment. +## Building from source -Alternatively, we also recommend building our own pre-set Auto-Mech environment, which includes MESS and all its dependencies. This environment can be created and activated with the commands: -``` -conda env create auto-mech/amech-env -conda activate amech-env -``` +The build uses [Pixi](https://pixi.sh), with all dependencies from conda-forge: +- ILP64 BLAS/LAPACK: `openblas-ilp64` +- GSL +- OpenMP +- SLATEC: the routines MESS needs are vendored in `external/SLATEC` -If your Conda commands are not functioning, you may need to iniliatize Conda via the command +From the repository root: ``` -. /path/to/conda.sh +pixi run test # build MESS (linked against conda-forge libraries) and run the examples +pixi run -e static test # the same for the fully static executables ``` -which places Conda executables in your PATH. The specific location of conda.sh depends on the Conda install. - -If you do not have Conda, it can be installed using the shell script -`debug/install-conda.sh`. - +The executables (`mess`, `messpf`, `messabs`) are in `.pixi/envs/default/bin/` and `.pixi/envs/static/bin/`. +`pixi shell` puts the default ones on your `PATH`. -### Building from source using Conda environment for dependencies +### Plain CMake -To build the code from source for development or debugging purposes, first -create a conda environment with the necessary dependencies as follows: -``` -conda env create -f environment.yml -``` -which will create the `mess-env` environment. -You can then activate the environment and build the code as follows: +`CMakeLists.txt` is a standard CMake project. It needs C, C++ and Fortran compilers, an ILP64 (64-bit integer) BLAS/LAPACK, GSL and OpenMP. ``` -conda activate mess-env -bash debug/build.sh +cmake -B build -DBLAS_LIBRARIES=/path/to/libopenblas64_.so -DLAPACK_LIBRARIES=/path/to/libopenblas64_.so -DMESS_BLAS_SUFFIX=64_ +cmake --build build ``` -To put the MESS executables in your PATH, you can then run -``` -. debug/fake-install.sh -``` -Note that the above command does not **permanently** alter your PATH, it only affects PATH for the current login session. - - -### Building from source without Conda - -This is not the advised way to install, since the user will have to deal with their specific system setup. - -Download SLATEC and MPACK from GitHub, and install them in a location that your system can find them. - -With SLATEC and MPACK installed, run build.sh, which uses cmake to compile MESS. -``` -bash build.sh -``` - -Note that the results of the `make install` command in build.sh will depend on your system setup. - -### Building from Source (CMake) - -This project uses CMake for building from source. Ensure you have CMake (version 3.16 or higher), a C++ compiler (supporting C++11), and a Fortran compiler installed. - -1. **Clone the repository (if you haven't already):** - ```bash - git clone https://github.com/keceli/MESS.git - cd MESS - ``` - -2. **Create a build directory and navigate into it:** - ```bash - mkdir build - cd build - ``` - -3. **Configure the project using CMake:** - Run CMake from the `build` directory, pointing to the parent directory (where the main `CMakeLists.txt` is located). - ```bash - cmake .. - ``` - This command prepares the build system. By default, it will try to find system libraries and download/build dependencies if they are not found. - - **Build Options (passed to the `cmake ..` command): - - * `AUTO_DOWNLOAD_DEPENDENCIES` (Default: `ON`): Automatically download and build missing dependencies. To disable, use: - ```bash - cmake -DAUTO_DOWNLOAD_DEPENDENCIES=OFF .. - ``` - * `USE_SYSTEM_LIBS` (Default: `ON`): Try to use system libraries before downloading. To disable (and force download/build of all dependencies), use: - ```bash - cmake -DUSE_SYSTEM_LIBS=OFF .. - ``` - * You can combine options: `cmake -DAUTO_DOWNLOAD_DEPENDENCIES=OFF -DUSE_SYSTEM_LIBS=OFF ..` - -4. **Compile the project:** - After CMake configuration is successful, run `make` (or your chosen build tool like `ninja`) in the `build` directory. - ```bash - make -jN # Replace N with the number of parallel jobs you want to use, e.g., make -j4 - ``` - This will compile the MESS executables (mess, mess-v2, messpf, messabs, messsym) and place them in the `build` directory. +Options: +- `BLAS_LIBRARIES`, `LAPACK_LIBRARIES`: the ILP64 library. These can be left out if CMake's FindBLAS finds it (e.g. `-DBLA_VENDOR=Intel10_64ilp` for MKL). +- `MESS_BLAS_SUFFIX`: the suffix on the library's BLAS/LAPACK symbol names, if any. For example, `64_` for OpenBLAS built with `SYMBOLSUFFIX=64_`, like conda-forge's `libopenblas64_.so`. Check with `nm -D | grep dsyev`. The static archive `libopenblas64_.a` has no suffix. +- `MESS_STATIC` (default `OFF`): link fully static executables. ## Reference diff --git a/examples/mess.inp b/examples/mess.inp index f9f508c..38e3c1c 100644 --- a/examples/mess.inp +++ b/examples/mess.inp @@ -1,3 +1,4 @@ +WithCRM # needed for the radiative transitions (Oscillators) below TemperatureList[K] 100. 200. PressureList[bar] 1.e-1 1. EnergyStepOverTemperature 0.5 #Ratio of discretization energy step to T diff --git a/external/SLATEC/README.md b/external/SLATEC/README.md new file mode 100644 index 0000000..32df3e4 --- /dev/null +++ b/external/SLATEC/README.md @@ -0,0 +1,22 @@ +# SLATEC (subset) + +These are the routines from the SLATEC Common Mathematical Library, Version 4.1 (July 1993), that MESS calls (`davint`, `dbint4`, `dbvalu`, `ddeabm`) and the routines they call, 24 files in all. +The top-level `CMakeLists.txt` builds them into a static library linked into the MESS executables. +They use the default (32-bit) Fortran `INTEGER`, which matches `Slatec::int_t` in `src/libmess/slatec.hh`. + +## Notice + +The files come from Giuseppe Borzi's SLATEC distribution: + +Giuseppe Borzi' +e-mail: etana@tiscalinet.it +http://web.tiscalinet.it/gborzi +Assistant Professor at the Univ. of Messina - Italia + +License: +General Public License. Slatec is 'Freely distributable' as they say. + +For further details, see . + +The subset deliberately leaves out SLATEC's copies of BLAS routines (`ddot`, `daxpy`, …), which none of these call. +They would clash with the ILP64 BLAS in a static link. diff --git a/external/SLATEC/src/d1mach.f b/external/SLATEC/src/d1mach.f new file mode 100644 index 0000000..6f10f70 --- /dev/null +++ b/external/SLATEC/src/d1mach.f @@ -0,0 +1,502 @@ +*DECK D1MACH + DOUBLE PRECISION FUNCTION D1MACH (I) +C***BEGIN PROLOGUE D1MACH +C***PURPOSE Return floating point machine dependent constants. +C***LIBRARY SLATEC +C***CATEGORY R1 +C***TYPE DOUBLE PRECISION (R1MACH-S, D1MACH-D) +C***KEYWORDS MACHINE CONSTANTS +C***AUTHOR Fox, P. A., (Bell Labs) +C Hall, A. D., (Bell Labs) +C Schryer, N. L., (Bell Labs) +C***DESCRIPTION +C +C D1MACH can be used to obtain machine-dependent parameters for the +C local machine environment. It is a function subprogram with one +C (input) argument, and can be referenced as follows: +C +C D = D1MACH(I) +C +C where I=1,...,5. The (output) value of D above is determined by +C the (input) value of I. The results for various values of I are +C discussed below. +C +C D1MACH( 1) = B**(EMIN-1), the smallest positive magnitude. +C D1MACH( 2) = B**EMAX*(1 - B**(-T)), the largest magnitude. +C D1MACH( 3) = B**(-T), the smallest relative spacing. +C D1MACH( 4) = B**(1-T), the largest relative spacing. +C D1MACH( 5) = LOG10(B) +C +C Assume double precision numbers are represented in the T-digit, +C base-B form +C +C sign (B**E)*( (X(1)/B) + ... + (X(T)/B**T) ) +C +C where 0 .LE. X(I) .LT. B for I=1,...,T, 0 .LT. X(1), and +C EMIN .LE. E .LE. EMAX. +C +C The values of B, T, EMIN and EMAX are provided in I1MACH as +C follows: +C I1MACH(10) = B, the base. +C I1MACH(14) = T, the number of base-B digits. +C I1MACH(15) = EMIN, the smallest exponent E. +C I1MACH(16) = EMAX, the largest exponent E. +C +C To alter this function for a particular environment, the desired +C set of DATA statements should be activated by removing the C from +C column 1. Also, the values of D1MACH(1) - D1MACH(4) should be +C checked for consistency with the local operating system. +C +C***REFERENCES P. A. Fox, A. D. Hall and N. L. Schryer, Framework for +C a portable library, ACM Transactions on Mathematical +C Software 4, 2 (June 1978), pp. 177-188. +C***ROUTINES CALLED XERMSG +C***REVISION HISTORY (YYMMDD) +C 750101 DATE WRITTEN +C 890213 REVISION DATE from Version 3.2 +C 891214 Prologue converted to Version 4.0 format. (BAB) +C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) +C 900618 Added DEC RISC constants. (WRB) +C 900723 Added IBM RS 6000 constants. (WRB) +C 900911 Added SUN 386i constants. (WRB) +C 910710 Added HP 730 constants. (SMR) +C 911114 Added Convex IEEE constants. (WRB) +C 920121 Added SUN -r8 compiler option constants. (WRB) +C 920229 Added Touchstone Delta i860 constants. (WRB) +C 920501 Reformatted the REFERENCES section. (WRB) +C 920625 Added CONVEX -p8 and -pd8 compiler option constants. +C (BKS, WRB) +C 930201 Added DEC Alpha and SGI constants. (RWC and WRB) +C***END PROLOGUE D1MACH +C + INTEGER SMALL(4) + INTEGER LARGE(4) + INTEGER RIGHT(4) + INTEGER DIVER(4) + INTEGER LOG10(4) +C + DOUBLE PRECISION DMACH(5) + SAVE DMACH +C + EQUIVALENCE (DMACH(1),SMALL(1)) + EQUIVALENCE (DMACH(2),LARGE(1)) + EQUIVALENCE (DMACH(3),RIGHT(1)) + EQUIVALENCE (DMACH(4),DIVER(1)) + EQUIVALENCE (DMACH(5),LOG10(1)) +C +C MACHINE CONSTANTS FOR THE AMIGA +C ABSOFT FORTRAN COMPILER USING THE 68020/68881 COMPILER OPTION +C +C DATA SMALL(1), SMALL(2) / Z'00100000', Z'00000000' / +C DATA LARGE(1), LARGE(2) / Z'7FEFFFFF', Z'FFFFFFFF' / +C DATA RIGHT(1), RIGHT(2) / Z'3CA00000', Z'00000000' / +C DATA DIVER(1), DIVER(2) / Z'3CB00000', Z'00000000' / +C DATA LOG10(1), LOG10(2) / Z'3FD34413', Z'509F79FF' / +C +C MACHINE CONSTANTS FOR THE AMIGA +C ABSOFT FORTRAN COMPILER USING SOFTWARE FLOATING POINT +C +C DATA SMALL(1), SMALL(2) / Z'00100000', Z'00000000' / +C DATA LARGE(1), LARGE(2) / Z'7FDFFFFF', Z'FFFFFFFF' / +C DATA RIGHT(1), RIGHT(2) / Z'3CA00000', Z'00000000' / +C DATA DIVER(1), DIVER(2) / Z'3CB00000', Z'00000000' / +C DATA LOG10(1), LOG10(2) / Z'3FD34413', Z'509F79FF' / +C +C MACHINE CONSTANTS FOR THE APOLLO +C +C DATA SMALL(1), SMALL(2) / 16#00100000, 16#00000000 / +C DATA LARGE(1), LARGE(2) / 16#7FFFFFFF, 16#FFFFFFFF / +C DATA RIGHT(1), RIGHT(2) / 16#3CA00000, 16#00000000 / +C DATA DIVER(1), DIVER(2) / 16#3CB00000, 16#00000000 / +C DATA LOG10(1), LOG10(2) / 16#3FD34413, 16#509F79FF / +C +C MACHINE CONSTANTS FOR THE BURROUGHS 1700 SYSTEM +C +C DATA SMALL(1) / ZC00800000 / +C DATA SMALL(2) / Z000000000 / +C DATA LARGE(1) / ZDFFFFFFFF / +C DATA LARGE(2) / ZFFFFFFFFF / +C DATA RIGHT(1) / ZCC5800000 / +C DATA RIGHT(2) / Z000000000 / +C DATA DIVER(1) / ZCC6800000 / +C DATA DIVER(2) / Z000000000 / +C DATA LOG10(1) / ZD00E730E7 / +C DATA LOG10(2) / ZC77800DC0 / +C +C MACHINE CONSTANTS FOR THE BURROUGHS 5700 SYSTEM +C +C DATA SMALL(1) / O1771000000000000 / +C DATA SMALL(2) / O0000000000000000 / +C DATA LARGE(1) / O0777777777777777 / +C DATA LARGE(2) / O0007777777777777 / +C DATA RIGHT(1) / O1461000000000000 / +C DATA RIGHT(2) / O0000000000000000 / +C DATA DIVER(1) / O1451000000000000 / +C DATA DIVER(2) / O0000000000000000 / +C DATA LOG10(1) / O1157163034761674 / +C DATA LOG10(2) / O0006677466732724 / +C +C MACHINE CONSTANTS FOR THE BURROUGHS 6700/7700 SYSTEMS +C +C DATA SMALL(1) / O1771000000000000 / +C DATA SMALL(2) / O7770000000000000 / +C DATA LARGE(1) / O0777777777777777 / +C DATA LARGE(2) / O7777777777777777 / +C DATA RIGHT(1) / O1461000000000000 / +C DATA RIGHT(2) / O0000000000000000 / +C DATA DIVER(1) / O1451000000000000 / +C DATA DIVER(2) / O0000000000000000 / +C DATA LOG10(1) / O1157163034761674 / +C DATA LOG10(2) / O0006677466732724 / +C +C MACHINE CONSTANTS FOR THE CDC 170/180 SERIES USING NOS/VE +C +C DATA SMALL(1) / Z"3001800000000000" / +C DATA SMALL(2) / Z"3001000000000000" / +C DATA LARGE(1) / Z"4FFEFFFFFFFFFFFE" / +C DATA LARGE(2) / Z"4FFE000000000000" / +C DATA RIGHT(1) / Z"3FD2800000000000" / +C DATA RIGHT(2) / Z"3FD2000000000000" / +C DATA DIVER(1) / Z"3FD3800000000000" / +C DATA DIVER(2) / Z"3FD3000000000000" / +C DATA LOG10(1) / Z"3FFF9A209A84FBCF" / +C DATA LOG10(2) / Z"3FFFF7988F8959AC" / +C +C MACHINE CONSTANTS FOR THE CDC 6000/7000 SERIES +C +C DATA SMALL(1) / 00564000000000000000B / +C DATA SMALL(2) / 00000000000000000000B / +C DATA LARGE(1) / 37757777777777777777B / +C DATA LARGE(2) / 37157777777777777777B / +C DATA RIGHT(1) / 15624000000000000000B / +C DATA RIGHT(2) / 00000000000000000000B / +C DATA DIVER(1) / 15634000000000000000B / +C DATA DIVER(2) / 00000000000000000000B / +C DATA LOG10(1) / 17164642023241175717B / +C DATA LOG10(2) / 16367571421742254654B / +C +C MACHINE CONSTANTS FOR THE CELERITY C1260 +C +C DATA SMALL(1), SMALL(2) / Z'00100000', Z'00000000' / +C DATA LARGE(1), LARGE(2) / Z'7FEFFFFF', Z'FFFFFFFF' / +C DATA RIGHT(1), RIGHT(2) / Z'3CA00000', Z'00000000' / +C DATA DIVER(1), DIVER(2) / Z'3CB00000', Z'00000000' / +C DATA LOG10(1), LOG10(2) / Z'3FD34413', Z'509F79FF' / +C +C MACHINE CONSTANTS FOR THE CONVEX +C USING THE -fn OR -pd8 COMPILER OPTION +C +C DATA DMACH(1) / Z'0010000000000000' / +C DATA DMACH(2) / Z'7FFFFFFFFFFFFFFF' / +C DATA DMACH(3) / Z'3CC0000000000000' / +C DATA DMACH(4) / Z'3CD0000000000000' / +C DATA DMACH(5) / Z'3FF34413509F79FF' / +C +C MACHINE CONSTANTS FOR THE CONVEX +C USING THE -fi COMPILER OPTION +C +C DATA DMACH(1) / Z'0010000000000000' / +C DATA DMACH(2) / Z'7FEFFFFFFFFFFFFF' / +C DATA DMACH(3) / Z'3CA0000000000000' / +C DATA DMACH(4) / Z'3CB0000000000000' / +C DATA DMACH(5) / Z'3FD34413509F79FF' / +C +C MACHINE CONSTANTS FOR THE CONVEX +C USING THE -p8 COMPILER OPTION +C +C DATA DMACH(1) / Z'00010000000000000000000000000000' / +C DATA DMACH(2) / Z'7FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF' / +C DATA DMACH(3) / Z'3F900000000000000000000000000000' / +C DATA DMACH(4) / Z'3F910000000000000000000000000000' / +C DATA DMACH(5) / Z'3FFF34413509F79FEF311F12B35816F9' / +C +C MACHINE CONSTANTS FOR THE CRAY +C +C DATA SMALL(1) / 201354000000000000000B / +C DATA SMALL(2) / 000000000000000000000B / +C DATA LARGE(1) / 577767777777777777777B / +C DATA LARGE(2) / 000007777777777777774B / +C DATA RIGHT(1) / 376434000000000000000B / +C DATA RIGHT(2) / 000000000000000000000B / +C DATA DIVER(1) / 376444000000000000000B / +C DATA DIVER(2) / 000000000000000000000B / +C DATA LOG10(1) / 377774642023241175717B / +C DATA LOG10(2) / 000007571421742254654B / +C +C MACHINE CONSTANTS FOR THE DATA GENERAL ECLIPSE S/200 +C NOTE - IT MAY BE APPROPRIATE TO INCLUDE THE FOLLOWING CARD - +C STATIC DMACH(5) +C +C DATA SMALL / 20K, 3*0 / +C DATA LARGE / 77777K, 3*177777K / +C DATA RIGHT / 31420K, 3*0 / +C DATA DIVER / 32020K, 3*0 / +C DATA LOG10 / 40423K, 42023K, 50237K, 74776K / +C +C MACHINE CONSTANTS FOR THE DEC ALPHA +C USING G_FLOAT +C +C DATA DMACH(1) / '0000000000000010'X / +C DATA DMACH(2) / 'FFFFFFFFFFFF7FFF'X / +C DATA DMACH(3) / '0000000000003CC0'X / +C DATA DMACH(4) / '0000000000003CD0'X / +C DATA DMACH(5) / '79FF509F44133FF3'X / +C +C MACHINE CONSTANTS FOR THE DEC ALPHA +C USING IEEE_FORMAT +C +C DATA DMACH(1) / '0010000000000000'X / +C DATA DMACH(2) / '7FEFFFFFFFFFFFFF'X / +C DATA DMACH(3) / '3CA0000000000000'X / +C DATA DMACH(4) / '3CB0000000000000'X / +C DATA DMACH(5) / '3FD34413509F79FF'X / +C +C MACHINE CONSTANTS FOR THE DEC RISC +C +C DATA SMALL(1), SMALL(2) / Z'00000000', Z'00100000'/ +C DATA LARGE(1), LARGE(2) / Z'FFFFFFFF', Z'7FEFFFFF'/ +C DATA RIGHT(1), RIGHT(2) / Z'00000000', Z'3CA00000'/ +C DATA DIVER(1), DIVER(2) / Z'00000000', Z'3CB00000'/ +C DATA LOG10(1), LOG10(2) / Z'509F79FF', Z'3FD34413'/ +C +C MACHINE CONSTANTS FOR THE DEC VAX +C USING D_FLOATING +C (EXPRESSED IN INTEGER AND HEXADECIMAL) +C THE HEX FORMAT BELOW MAY NOT BE SUITABLE FOR UNIX SYSTEMS +C THE INTEGER FORMAT SHOULD BE OK FOR UNIX SYSTEMS +C +C DATA SMALL(1), SMALL(2) / 128, 0 / +C DATA LARGE(1), LARGE(2) / -32769, -1 / +C DATA RIGHT(1), RIGHT(2) / 9344, 0 / +C DATA DIVER(1), DIVER(2) / 9472, 0 / +C DATA LOG10(1), LOG10(2) / 546979738, -805796613 / +C +C DATA SMALL(1), SMALL(2) / Z00000080, Z00000000 / +C DATA LARGE(1), LARGE(2) / ZFFFF7FFF, ZFFFFFFFF / +C DATA RIGHT(1), RIGHT(2) / Z00002480, Z00000000 / +C DATA DIVER(1), DIVER(2) / Z00002500, Z00000000 / +C DATA LOG10(1), LOG10(2) / Z209A3F9A, ZCFF884FB / +C +C MACHINE CONSTANTS FOR THE DEC VAX +C USING G_FLOATING +C (EXPRESSED IN INTEGER AND HEXADECIMAL) +C THE HEX FORMAT BELOW MAY NOT BE SUITABLE FOR UNIX SYSTEMS +C THE INTEGER FORMAT SHOULD BE OK FOR UNIX SYSTEMS +C +C DATA SMALL(1), SMALL(2) / 16, 0 / +C DATA LARGE(1), LARGE(2) / -32769, -1 / +C DATA RIGHT(1), RIGHT(2) / 15552, 0 / +C DATA DIVER(1), DIVER(2) / 15568, 0 / +C DATA LOG10(1), LOG10(2) / 1142112243, 2046775455 / +C +C DATA SMALL(1), SMALL(2) / Z00000010, Z00000000 / +C DATA LARGE(1), LARGE(2) / ZFFFF7FFF, ZFFFFFFFF / +C DATA RIGHT(1), RIGHT(2) / Z00003CC0, Z00000000 / +C DATA DIVER(1), DIVER(2) / Z00003CD0, Z00000000 / +C DATA LOG10(1), LOG10(2) / Z44133FF3, Z79FF509F / +C +C MACHINE CONSTANTS FOR THE ELXSI 6400 +C (ASSUMING REAL*8 IS THE DEFAULT DOUBLE PRECISION) +C +C DATA SMALL(1), SMALL(2) / '00100000'X,'00000000'X / +C DATA LARGE(1), LARGE(2) / '7FEFFFFF'X,'FFFFFFFF'X / +C DATA RIGHT(1), RIGHT(2) / '3CB00000'X,'00000000'X / +C DATA DIVER(1), DIVER(2) / '3CC00000'X,'00000000'X / +C DATA LOG10(1), LOG10(2) / '3FD34413'X,'509F79FF'X / +C +C MACHINE CONSTANTS FOR THE HARRIS 220 +C +C DATA SMALL(1), SMALL(2) / '20000000, '00000201 / +C DATA LARGE(1), LARGE(2) / '37777777, '37777577 / +C DATA RIGHT(1), RIGHT(2) / '20000000, '00000333 / +C DATA DIVER(1), DIVER(2) / '20000000, '00000334 / +C DATA LOG10(1), LOG10(2) / '23210115, '10237777 / +C +C MACHINE CONSTANTS FOR THE HONEYWELL 600/6000 SERIES +C +C DATA SMALL(1), SMALL(2) / O402400000000, O000000000000 / +C DATA LARGE(1), LARGE(2) / O376777777777, O777777777777 / +C DATA RIGHT(1), RIGHT(2) / O604400000000, O000000000000 / +C DATA DIVER(1), DIVER(2) / O606400000000, O000000000000 / +C DATA LOG10(1), LOG10(2) / O776464202324, O117571775714 / +C +C MACHINE CONSTANTS FOR THE HP 730 +C +C DATA DMACH(1) / Z'0010000000000000' / +C DATA DMACH(2) / Z'7FEFFFFFFFFFFFFF' / +C DATA DMACH(3) / Z'3CA0000000000000' / +C DATA DMACH(4) / Z'3CB0000000000000' / +C DATA DMACH(5) / Z'3FD34413509F79FF' / +C +C MACHINE CONSTANTS FOR THE HP 2100 +C THREE WORD DOUBLE PRECISION OPTION WITH FTN4 +C +C DATA SMALL(1), SMALL(2), SMALL(3) / 40000B, 0, 1 / +C DATA LARGE(1), LARGE(2), LARGE(3) / 77777B, 177777B, 177776B / +C DATA RIGHT(1), RIGHT(2), RIGHT(3) / 40000B, 0, 265B / +C DATA DIVER(1), DIVER(2), DIVER(3) / 40000B, 0, 276B / +C DATA LOG10(1), LOG10(2), LOG10(3) / 46420B, 46502B, 77777B / +C +C MACHINE CONSTANTS FOR THE HP 2100 +C FOUR WORD DOUBLE PRECISION OPTION WITH FTN4 +C +C DATA SMALL(1), SMALL(2) / 40000B, 0 / +C DATA SMALL(3), SMALL(4) / 0, 1 / +C DATA LARGE(1), LARGE(2) / 77777B, 177777B / +C DATA LARGE(3), LARGE(4) / 177777B, 177776B / +C DATA RIGHT(1), RIGHT(2) / 40000B, 0 / +C DATA RIGHT(3), RIGHT(4) / 0, 225B / +C DATA DIVER(1), DIVER(2) / 40000B, 0 / +C DATA DIVER(3), DIVER(4) / 0, 227B / +C DATA LOG10(1), LOG10(2) / 46420B, 46502B / +C DATA LOG10(3), LOG10(4) / 76747B, 176377B / +C +C MACHINE CONSTANTS FOR THE HP 9000 +C +C DATA SMALL(1), SMALL(2) / 00040000000B, 00000000000B / +C DATA LARGE(1), LARGE(2) / 17737777777B, 37777777777B / +C DATA RIGHT(1), RIGHT(2) / 07454000000B, 00000000000B / +C DATA DIVER(1), DIVER(2) / 07460000000B, 00000000000B / +C DATA LOG10(1), LOG10(2) / 07764642023B, 12047674777B / +C +C MACHINE CONSTANTS FOR THE IBM 360/370 SERIES, +C THE XEROX SIGMA 5/7/9, THE SEL SYSTEMS 85/86, AND +C THE PERKIN ELMER (INTERDATA) 7/32. +C +C DATA SMALL(1), SMALL(2) / Z00100000, Z00000000 / +C DATA LARGE(1), LARGE(2) / Z7FFFFFFF, ZFFFFFFFF / +C DATA RIGHT(1), RIGHT(2) / Z33100000, Z00000000 / +C DATA DIVER(1), DIVER(2) / Z34100000, Z00000000 / +C DATA LOG10(1), LOG10(2) / Z41134413, Z509F79FF / +C +C MACHINE CONSTANTS FOR THE IBM PC +C ASSUMES THAT ALL ARITHMETIC IS DONE IN DOUBLE PRECISION +C ON 8088, I.E., NOT IN 80 BIT FORM FOR THE 8087. +C +C DATA SMALL(1) / 2.23D-308 / +C DATA LARGE(1) / 1.79D+308 / +C DATA RIGHT(1) / 1.11D-16 / +C DATA DIVER(1) / 2.22D-16 / +C DATA LOG10(1) / 0.301029995663981195D0 / +C +C MACHINE CONSTANTS FOR THE IBM RS 6000 +C +C DATA DMACH(1) / Z'0010000000000000' / +C DATA DMACH(2) / Z'7FEFFFFFFFFFFFFF' / +C DATA DMACH(3) / Z'3CA0000000000000' / +C DATA DMACH(4) / Z'3CB0000000000000' / +C DATA DMACH(5) / Z'3FD34413509F79FF' / +C +C MACHINE CONSTANTS FOR THE INTEL i860 +C +C DATA DMACH(1) / Z'0010000000000000' / +C DATA DMACH(2) / Z'7FEFFFFFFFFFFFFF' / +C DATA DMACH(3) / Z'3CA0000000000000' / +C DATA DMACH(4) / Z'3CB0000000000000' / +C DATA DMACH(5) / Z'3FD34413509F79FF' / +C +C MACHINE CONSTANTS FOR THE PDP-10 (KA PROCESSOR) +C +C DATA SMALL(1), SMALL(2) / "033400000000, "000000000000 / +C DATA LARGE(1), LARGE(2) / "377777777777, "344777777777 / +C DATA RIGHT(1), RIGHT(2) / "113400000000, "000000000000 / +C DATA DIVER(1), DIVER(2) / "114400000000, "000000000000 / +C DATA LOG10(1), LOG10(2) / "177464202324, "144117571776 / +C +C MACHINE CONSTANTS FOR THE PDP-10 (KI PROCESSOR) +C +C DATA SMALL(1), SMALL(2) / "000400000000, "000000000000 / +C DATA LARGE(1), LARGE(2) / "377777777777, "377777777777 / +C DATA RIGHT(1), RIGHT(2) / "103400000000, "000000000000 / +C DATA DIVER(1), DIVER(2) / "104400000000, "000000000000 / +C DATA LOG10(1), LOG10(2) / "177464202324, "476747767461 / +C +C MACHINE CONSTANTS FOR PDP-11 FORTRAN SUPPORTING +C 32-BIT INTEGERS (EXPRESSED IN INTEGER AND OCTAL). +C +C DATA SMALL(1), SMALL(2) / 8388608, 0 / +C DATA LARGE(1), LARGE(2) / 2147483647, -1 / +C DATA RIGHT(1), RIGHT(2) / 612368384, 0 / +C DATA DIVER(1), DIVER(2) / 620756992, 0 / +C DATA LOG10(1), LOG10(2) / 1067065498, -2063872008 / +C +C DATA SMALL(1), SMALL(2) / O00040000000, O00000000000 / +C DATA LARGE(1), LARGE(2) / O17777777777, O37777777777 / +C DATA RIGHT(1), RIGHT(2) / O04440000000, O00000000000 / +C DATA DIVER(1), DIVER(2) / O04500000000, O00000000000 / +C DATA LOG10(1), LOG10(2) / O07746420232, O20476747770 / +C +C MACHINE CONSTANTS FOR PDP-11 FORTRAN SUPPORTING +C 16-BIT INTEGERS (EXPRESSED IN INTEGER AND OCTAL). +C +C DATA SMALL(1), SMALL(2) / 128, 0 / +C DATA SMALL(3), SMALL(4) / 0, 0 / +C DATA LARGE(1), LARGE(2) / 32767, -1 / +C DATA LARGE(3), LARGE(4) / -1, -1 / +C DATA RIGHT(1), RIGHT(2) / 9344, 0 / +C DATA RIGHT(3), RIGHT(4) / 0, 0 / +C DATA DIVER(1), DIVER(2) / 9472, 0 / +C DATA DIVER(3), DIVER(4) / 0, 0 / +C DATA LOG10(1), LOG10(2) / 16282, 8346 / +C DATA LOG10(3), LOG10(4) / -31493, -12296 / +C +C DATA SMALL(1), SMALL(2) / O000200, O000000 / +C DATA SMALL(3), SMALL(4) / O000000, O000000 / +C DATA LARGE(1), LARGE(2) / O077777, O177777 / +C DATA LARGE(3), LARGE(4) / O177777, O177777 / +C DATA RIGHT(1), RIGHT(2) / O022200, O000000 / +C DATA RIGHT(3), RIGHT(4) / O000000, O000000 / +C DATA DIVER(1), DIVER(2) / O022400, O000000 / +C DATA DIVER(3), DIVER(4) / O000000, O000000 / +C DATA LOG10(1), LOG10(2) / O037632, O020232 / +C DATA LOG10(3), LOG10(4) / O102373, O147770 / +C +C MACHINE CONSTANTS FOR THE SILICON GRAPHICS +C +C DATA SMALL(1), SMALL(2) / Z'00100000', Z'00000000' / +C DATA LARGE(1), LARGE(2) / Z'7FEFFFFF', Z'FFFFFFFF' / +C DATA RIGHT(1), RIGHT(2) / Z'3CA00000', Z'00000000' / +C DATA DIVER(1), DIVER(2) / Z'3CB00000', Z'00000000' / +C DATA LOG10(1), LOG10(2) / Z'3FD34413', Z'509F79FF' / +C +C MACHINE CONSTANTS FOR THE SUN +C +C DATA DMACH(1) / Z'0010000000000000' / +C DATA DMACH(2) / Z'7FEFFFFFFFFFFFFF' / +C DATA DMACH(3) / Z'3CA0000000000000' / +C DATA DMACH(4) / Z'3CB0000000000000' / +C DATA DMACH(5) / Z'3FD34413509F79FF' / +C +C MACHINE CONSTANTS FOR THE SUN +C USING THE -r8 COMPILER OPTION +C +C DATA DMACH(1) / Z'00010000000000000000000000000000' / +C DATA DMACH(2) / Z'7FFEFFFFFFFFFFFFFFFFFFFFFFFFFFFF' / +C DATA DMACH(3) / Z'3F8E0000000000000000000000000000' / +C DATA DMACH(4) / Z'3F8F0000000000000000000000000000' / +C DATA DMACH(5) / Z'3FFD34413509F79FEF311F12B35816F9' / +C +C MACHINE CONSTANTS FOR THE SUN 386i +C +C DATA SMALL(1), SMALL(2) / Z'FFFFFFFD', Z'000FFFFF' / +C DATA LARGE(1), LARGE(2) / Z'FFFFFFB0', Z'7FEFFFFF' / +C DATA RIGHT(1), RIGHT(2) / Z'000000B0', Z'3CA00000' / +C DATA DIVER(1), DIVER(2) / Z'FFFFFFCB', Z'3CAFFFFF' +C DATA LOG10(1), LOG10(2) / Z'509F79E9', Z'3FD34413' / +C +C MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES FTN COMPILER +C +C DATA SMALL(1), SMALL(2) / O000040000000, O000000000000 / +C DATA LARGE(1), LARGE(2) / O377777777777, O777777777777 / +C DATA RIGHT(1), RIGHT(2) / O170540000000, O000000000000 / +C DATA DIVER(1), DIVER(2) / O170640000000, O000000000000 / +C DATA LOG10(1), LOG10(2) / O177746420232, O411757177572 / +C +C***FIRST EXECUTABLE STATEMENT D1MACH + IF (I .LT. 1 .OR. I .GT. 5) CALL XERMSG ('SLATEC', 'D1MACH', + + 'I OUT OF BOUNDS', 1, 2) +C + D1MACH = DMACH(I) + RETURN +C + END diff --git a/external/SLATEC/src/davint.f b/external/SLATEC/src/davint.f new file mode 100644 index 0000000..b9a255f --- /dev/null +++ b/external/SLATEC/src/davint.f @@ -0,0 +1,214 @@ +*DECK DAVINT + SUBROUTINE DAVINT (X, Y, N, XLO, XUP, ANS, IERR) +C***BEGIN PROLOGUE DAVINT +C***PURPOSE Integrate a function tabulated at arbitrarily spaced +C abscissas using overlapping parabolas. +C***LIBRARY SLATEC +C***CATEGORY H2A1B2 +C***TYPE DOUBLE PRECISION (AVINT-S, DAVINT-D) +C***KEYWORDS INTEGRATION, QUADRATURE, TABULATED DATA +C***AUTHOR Jones, R. E., (SNLA) +C***DESCRIPTION +C +C Abstract +C DAVINT integrates a function tabulated at arbitrarily spaced +C abscissas. The limits of integration need not coincide +C with the tabulated abscissas. +C +C A method of overlapping parabolas fitted to the data is used +C provided that there are at least 3 abscissas between the +C limits of integration. DAVINT also handles two special cases. +C If the limits of integration are equal, DAVINT returns a +C result of zero regardless of the number of tabulated values. +C If there are only two function values, DAVINT uses the +C trapezoid rule. +C +C Description of Parameters +C The user must dimension all arrays appearing in the call list +C X(N), Y(N) +C +C Input-- +C X - DOUBLE PRECISION array of abscissas, which must be in +C increasing order. +C Y - DOUBLE PRECISION array of function values. i.e., +C Y(I)=FUNC(X(I)) +C N - The integer number of function values supplied. +C N .GE. 2 unless XLO = XUP. +C XLO - DOUBLE PRECISION lower limit of integration +C XUP - DOUBLE PRECISION upper limit of integration. Must have +C XLO.LE.XUP +C +C Output-- +C ANS - Double Precision computed approximate value of integral +C IERR - A status code +C --Normal Code +C =1 Means the requested integration was performed. +C --Abnormal Codes +C =2 Means XUP was less than XLO. +C =3 Means the number of X(I) between XLO and XUP +C (inclusive) was less than 3 and neither of the two +C special cases described in the abstract occurred. +C No integration was performed. +C =4 Means the restriction X(I+1).GT.X(I) was violated. +C =5 Means the number N of function values was .lt. 2. +C ANS is set to zero if IERR=2,3,4,or 5. +C +C DAVINT is documented completely in SC-M-69-335 +C Original program from *Numerical Integration* by Davis & Rabinowitz +C Adaptation and modifications by Rondall E Jones. +C +C***REFERENCES R. E. Jones, Approximate integrator of functions +C tabulated at arbitrarily spaced abscissas, +C Report SC-M-69-335, Sandia Laboratories, 1969. +C***ROUTINES CALLED XERMSG +C***REVISION HISTORY (YYMMDD) +C 690901 DATE WRITTEN +C 890831 Modified array declarations. (WRB) +C 890831 REVISION DATE from Version 3.2 +C 891214 Prologue converted to Version 4.0 format. (BAB) +C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) +C 920501 Reformatted the REFERENCES section. (WRB) +C***END PROLOGUE DAVINT +C + INTEGER I, IERR, INLFT, INRT, ISTART, ISTOP, N + DOUBLE PRECISION A, ANS, B, C, CA, CB, CC, FL, FR, R3, RP5, + 1 SLOPE, SUM, SYL, SYL2, SYL3, SYU, SYU2, SYU3, TERM1, TERM2, + 2 TERM3, X, X1, X12, X13, X2, X23, X3, XLO, XUP, Y + DIMENSION X(*),Y(*) +C BEGIN BLOCK PERMITTING ...EXITS TO 190 +C BEGIN BLOCK PERMITTING ...EXITS TO 180 +C***FIRST EXECUTABLE STATEMENT DAVINT + IERR = 1 + ANS = 0.0D0 + IF (XLO .GT. XUP) GO TO 160 + IF (XLO .EQ. XUP) GO TO 150 + IF (N .GE. 2) GO TO 10 + IERR = 5 + CALL XERMSG ('SLATEC', 'DAVINT', + + 'LESS THAN TWO FUNCTION VALUES WERE SUPPLIED.', + + 4, 1) +C ...............EXIT + GO TO 190 + 10 CONTINUE + DO 20 I = 2, N +C ............EXIT + IF (X(I) .LE. X(I-1)) GO TO 180 +C ...EXIT + IF (X(I) .GT. XUP) GO TO 30 + 20 CONTINUE + 30 CONTINUE + IF (N .GE. 3) GO TO 40 +C +C SPECIAL N=2 CASE + SLOPE = (Y(2) - Y(1))/(X(2) - X(1)) + FL = Y(1) + SLOPE*(XLO - X(1)) + FR = Y(2) + SLOPE*(XUP - X(2)) + ANS = 0.5D0*(FL + FR)*(XUP - XLO) +C ...............EXIT + GO TO 190 + 40 CONTINUE + IF (X(N-2) .GE. XLO) GO TO 50 + IERR = 3 + CALL XERMSG ('SLATEC', 'DAVINT', + + 'THERE WERE LESS THAN THREE FUNCTION VALUES ' // + + 'BETWEEN THE LIMITS OF INTEGRATION.', 4, 1) +C ...............EXIT + GO TO 190 + 50 CONTINUE + IF (X(3) .LE. XUP) GO TO 60 + IERR = 3 + CALL XERMSG ('SLATEC', 'DAVINT', + + 'THERE WERE LESS THAN THREE FUNCTION VALUES ' // + + 'BETWEEN THE LIMITS OF INTEGRATION.', 4, 1) +C ...............EXIT + GO TO 190 + 60 CONTINUE + I = 1 + 70 IF (X(I) .GE. XLO) GO TO 80 + I = I + 1 + GO TO 70 + 80 CONTINUE + INLFT = I + I = N + 90 IF (X(I) .LE. XUP) GO TO 100 + I = I - 1 + GO TO 90 + 100 CONTINUE + INRT = I + IF ((INRT - INLFT) .GE. 2) GO TO 110 + IERR = 3 + CALL XERMSG ('SLATEC', 'DAVINT', + + 'THERE WERE LESS THAN THREE FUNCTION VALUES ' // + + 'BETWEEN THE LIMITS OF INTEGRATION.', 4, 1) +C ...............EXIT + GO TO 190 + 110 CONTINUE + ISTART = INLFT + IF (INLFT .EQ. 1) ISTART = 2 + ISTOP = INRT + IF (INRT .EQ. N) ISTOP = N - 1 +C + R3 = 3.0D0 + RP5 = 0.5D0 + SUM = 0.0D0 + SYL = XLO + SYL2 = SYL*SYL + SYL3 = SYL2*SYL +C + DO 140 I = ISTART, ISTOP + X1 = X(I-1) + X2 = X(I) + X3 = X(I+1) + X12 = X1 - X2 + X13 = X1 - X3 + X23 = X2 - X3 + TERM1 = Y(I-1)/(X12*X13) + TERM2 = -Y(I)/(X12*X23) + TERM3 = Y(I+1)/(X13*X23) + A = TERM1 + TERM2 + TERM3 + B = -(X2 + X3)*TERM1 - (X1 + X3)*TERM2 + 1 - (X1 + X2)*TERM3 + C = X2*X3*TERM1 + X1*X3*TERM2 + X1*X2*TERM3 + IF (I .GT. ISTART) GO TO 120 + CA = A + CB = B + CC = C + GO TO 130 + 120 CONTINUE + CA = 0.5D0*(A + CA) + CB = 0.5D0*(B + CB) + CC = 0.5D0*(C + CC) + 130 CONTINUE + SYU = X2 + SYU2 = SYU*SYU + SYU3 = SYU2*SYU + SUM = SUM + CA*(SYU3 - SYL3)/R3 + 1 + CB*RP5*(SYU2 - SYL2) + CC*(SYU - SYL) + CA = A + CB = B + CC = C + SYL = SYU + SYL2 = SYU2 + SYL3 = SYU3 + 140 CONTINUE + SYU = XUP + ANS = SUM + CA*(SYU**3 - SYL3)/R3 + 1 + CB*RP5*(SYU**2 - SYL2) + CC*(SYU - SYL) + 150 CONTINUE + GO TO 170 + 160 CONTINUE + IERR = 2 + CALL XERMSG ('SLATEC', 'DAVINT', + + 'THE UPPER LIMIT OF INTEGRATION WAS NOT GREATER ' // + + 'THAN THE LOWER LIMIT.', 4, 1) + 170 CONTINUE +C ......EXIT + GO TO 190 + 180 CONTINUE + IERR = 4 + CALL XERMSG ('SLATEC', 'DAVINT', + + 'THE ABSCISSAS WERE NOT STRICTLY INCREASING. MUST HAVE ' // + + 'X(I-1) .LT. X(I) FOR ALL I.', 4, 1) + 190 CONTINUE + RETURN + END diff --git a/external/SLATEC/src/dbint4.f b/external/SLATEC/src/dbint4.f new file mode 100644 index 0000000..9e239de --- /dev/null +++ b/external/SLATEC/src/dbint4.f @@ -0,0 +1,241 @@ +*DECK DBINT4 + SUBROUTINE DBINT4 (X, Y, NDATA, IBCL, IBCR, FBCL, FBCR, KNTOPT, T, + + BCOEF, N, K, W) +C***BEGIN PROLOGUE DBINT4 +C***PURPOSE Compute the B-representation of a cubic spline +C which interpolates given data. +C***LIBRARY SLATEC +C***CATEGORY E1A +C***TYPE DOUBLE PRECISION (BINT4-S, DBINT4-D) +C***KEYWORDS B-SPLINE, CUBIC SPLINES, DATA FITTING, INTERPOLATION +C***AUTHOR Amos, D. E., (SNLA) +C***DESCRIPTION +C +C Abstract **** a double precision routine **** +C +C DBINT4 computes the B representation (T,BCOEF,N,K) of a +C cubic spline (K=4) which interpolates data (X(I),Y(I)), +C I=1,NDATA. Parameters IBCL, IBCR, FBCL, FBCR allow the +C specification of the spline first or second derivative at +C both X(1) and X(NDATA). When this data is not specified +C by the problem, it is common practice to use a natural +C spline by setting second derivatives at X(1) and X(NDATA) +C to zero (IBCL=IBCR=2,FBCL=FBCR=0.0). The spline is defined +C on T(4) .LE. X .LE. T(N+1) with (ordered) interior knots at +C X(I) values where N=NDATA+2. The knots T(1),T(2),T(3) lie to +C the left of T(4)=X(1) and the knots T(N+2), T(N+3), T(N+4) +C lie to the right of T(N+1)=X(NDATA) in increasing order. If +C no extrapolation outside (X(1),X(NDATA)) is anticipated, the +C knots T(1)=T(2)=T(3)=T(4)=X(1) and T(N+2)=T(N+3)=T(N+4)= +C T(N+1)=X(NDATA) can be specified by KNTOPT=1. KNTOPT=2 +C selects a knot placement for T(1), T(2), T(3) to make the +C first 7 knots symmetric about T(4)=X(1) and similarly for +C T(N+2), T(N+3), T(N+4) about T(N+1)=X(NDATA). KNTOPT=3 +C allows the user to make his own selection, in increasing +C order, for T(1), T(2), T(3) to the left of X(1) and T(N+2), +C T(N+3), T(N+4) to the right of X(NDATA) in the work array +C W(1) through W(6). In any case, the interpolation on +C T(4) .LE. X .LE. T(N+1) by using function DBVALU is unique +C for given boundary conditions. +C +C Description of Arguments +C +C Input X,Y,FBCL,FBCR,W are double precision +C X - X vector of abscissae of length NDATA, distinct +C and in increasing order +C Y - Y vector of ordinates of length NDATA +C NDATA - number of data points, NDATA .GE. 2 +C IBCL - selection parameter for left boundary condition +C IBCL = 1 constrain the first derivative at +C X(1) to FBCL +C = 2 constrain the second derivative at +C X(1) to FBCL +C IBCR - selection parameter for right boundary condition +C IBCR = 1 constrain first derivative at +C X(NDATA) to FBCR +C IBCR = 2 constrain second derivative at +C X(NDATA) to FBCR +C FBCL - left boundary values governed by IBCL +C FBCR - right boundary values governed by IBCR +C KNTOPT - knot selection parameter +C KNTOPT = 1 sets knot multiplicity at T(4) and +C T(N+1) to 4 +C = 2 sets a symmetric placement of knots +C about T(4) and T(N+1) +C = 3 sets T(I)=W(I) and T(N+1+I)=W(3+I),I=1,3 +C where W(I),I=1,6 is supplied by the user +C W - work array of dimension at least 5*(NDATA+2) +C If KNTOPT=3, then W(1),W(2),W(3) are knot values to +C the left of X(1) and W(4),W(5),W(6) are knot +C values to the right of X(NDATA) in increasing +C order to be supplied by the user +C +C Output T,BCOEF are double precision +C T - knot array of length N+4 +C BCOEF - B spline coefficient array of length N +C N - number of coefficients, N=NDATA+2 +C K - order of spline, K=4 +C +C Error Conditions +C Improper input is a fatal error +C Singular system of equations is a fatal error +C +C***REFERENCES D. E. Amos, Computation with splines and B-splines, +C Report SAND78-1968, Sandia Laboratories, March 1979. +C Carl de Boor, Package for calculating with B-splines, +C SIAM Journal on Numerical Analysis 14, 3 (June 1977), +C pp. 441-472. +C Carl de Boor, A Practical Guide to Splines, Applied +C Mathematics Series 27, Springer-Verlag, New York, +C 1978. +C***ROUTINES CALLED D1MACH, DBNFAC, DBNSLV, DBSPVD, XERMSG +C***REVISION HISTORY (YYMMDD) +C 800901 DATE WRITTEN +C 890531 Changed all specific intrinsics to generic. (WRB) +C 890531 REVISION DATE from Version 3.2 +C 891214 Prologue converted to Version 4.0 format. (BAB) +C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) +C 900326 Removed duplicate information from DESCRIPTION section. +C (WRB) +C 920501 Reformatted the REFERENCES section. (WRB) +C***END PROLOGUE DBINT4 +C + INTEGER I, IBCL, IBCR, IFLAG, ILB, ILEFT, IT, IUB, IW, IWP, J, + 1 JW, K, KNTOPT, N, NDATA, NDM, NP, NWROW + DOUBLE PRECISION BCOEF,FBCL,FBCR,T,TOL,TXN,TX1,VNIKX,W,WDTOL, + 1 WORK,X,XL,Y + DOUBLE PRECISION D1MACH + DIMENSION X(*), Y(*), T(*), BCOEF(*), W(5,*), VNIKX(4,4), WORK(15) +C***FIRST EXECUTABLE STATEMENT DBINT4 + WDTOL = D1MACH(4) + TOL = SQRT(WDTOL) + IF (NDATA.LT.2) GO TO 200 + NDM = NDATA - 1 + DO 10 I=1,NDM + IF (X(I).GE.X(I+1)) GO TO 210 + 10 CONTINUE + IF (IBCL.LT.1 .OR. IBCL.GT.2) GO TO 220 + IF (IBCR.LT.1 .OR. IBCR.GT.2) GO TO 230 + IF (KNTOPT.LT.1 .OR. KNTOPT.GT.3) GO TO 240 + K = 4 + N = NDATA + 2 + NP = N + 1 + DO 20 I=1,NDATA + T(I+3) = X(I) + 20 CONTINUE + GO TO (30, 50, 90), KNTOPT +C SET UP KNOT ARRAY WITH MULTIPLICITY 4 AT X(1) AND X(NDATA) + 30 CONTINUE + DO 40 I=1,3 + T(4-I) = X(1) + T(NP+I) = X(NDATA) + 40 CONTINUE + GO TO 110 +C SET UP KNOT ARRAY WITH SYMMETRIC PLACEMENT ABOUT END POINTS + 50 CONTINUE + IF (NDATA.GT.3) GO TO 70 + XL = (X(NDATA)-X(1))/3.0D0 + DO 60 I=1,3 + T(4-I) = T(5-I) - XL + T(NP+I) = T(NP+I-1) + XL + 60 CONTINUE + GO TO 110 + 70 CONTINUE + TX1 = X(1) + X(1) + TXN = X(NDATA) + X(NDATA) + DO 80 I=1,3 + T(4-I) = TX1 - X(I+1) + T(NP+I) = TXN - X(NDATA-I) + 80 CONTINUE + GO TO 110 +C SET UP KNOT ARRAY LESS THAN X(1) AND GREATER THAN X(NDATA) TO BE +C SUPPLIED BY USER IN WORK LOCATIONS W(1) THROUGH W(6) WHEN KNTOPT=3 + 90 CONTINUE + DO 100 I=1,3 + T(4-I) = W(4-I,1) + JW = MAX(1,I-1) + IW = MOD(I+2,5)+1 + T(NP+I) = W(IW,JW) + IF (T(4-I).GT.T(5-I)) GO TO 250 + IF (T(NP+I).LT.T(NP+I-1)) GO TO 250 + 100 CONTINUE + 110 CONTINUE +C + DO 130 I=1,5 + DO 120 J=1,N + W(I,J) = 0.0D0 + 120 CONTINUE + 130 CONTINUE +C SET UP LEFT INTERPOLATION POINT AND LEFT BOUNDARY CONDITION FOR +C RIGHT LIMITS + IT = IBCL + 1 + CALL DBSPVD(T, K, IT, X(1), K, 4, VNIKX, WORK) + IW = 0 + IF (ABS(VNIKX(3,1)).LT.TOL) IW = 1 + DO 140 J=1,3 + W(J+1,4-J) = VNIKX(4-J,IT) + W(J,4-J) = VNIKX(4-J,1) + 140 CONTINUE + BCOEF(1) = Y(1) + BCOEF(2) = FBCL +C SET UP INTERPOLATION EQUATIONS FOR POINTS I=2 TO I=NDATA-1 + ILEFT = 4 + IF (NDM.LT.2) GO TO 170 + DO 160 I=2,NDM + ILEFT = ILEFT + 1 + CALL DBSPVD(T, K, 1, X(I), ILEFT, 4, VNIKX, WORK) + DO 150 J=1,3 + W(J+1,3+I-J) = VNIKX(4-J,1) + 150 CONTINUE + BCOEF(I+1) = Y(I) + 160 CONTINUE +C SET UP RIGHT INTERPOLATION POINT AND RIGHT BOUNDARY CONDITION FOR +C LEFT LIMITS(ILEFT IS ASSOCIATED WITH T(N)=X(NDATA-1)) + 170 CONTINUE + IT = IBCR + 1 + CALL DBSPVD(T, K, IT, X(NDATA), ILEFT, 4, VNIKX, WORK) + JW = 0 + IF (ABS(VNIKX(2,1)).LT.TOL) JW = 1 + DO 180 J=1,3 + W(J+1,3+NDATA-J) = VNIKX(5-J,IT) + W(J+2,3+NDATA-J) = VNIKX(5-J,1) + 180 CONTINUE + BCOEF(N-1) = FBCR + BCOEF(N) = Y(NDATA) +C SOLVE SYSTEM OF EQUATIONS + ILB = 2 - JW + IUB = 2 - IW + NWROW = 5 + IWP = IW + 1 + CALL DBNFAC(W(IWP,1), NWROW, N, ILB, IUB, IFLAG) + IF (IFLAG.EQ.2) GO TO 190 + CALL DBNSLV(W(IWP,1), NWROW, N, ILB, IUB, BCOEF) + RETURN +C +C + 190 CONTINUE + CALL XERMSG ('SLATEC', 'DBINT4', + + 'THE SYSTEM OF EQUATIONS IS SINGULAR', 2, 1) + RETURN + 200 CONTINUE + CALL XERMSG ('SLATEC', 'DBINT4', 'NDATA IS LESS THAN 2', 2, 1) + RETURN + 210 CONTINUE + CALL XERMSG ('SLATEC', 'DBINT4', + + 'X VALUES ARE NOT DISTINCT OR NOT ORDERED', 2, 1) + RETURN + 220 CONTINUE + CALL XERMSG ('SLATEC', 'DBINT4', 'IBCL IS NOT 1 OR 2', 2, 1) + RETURN + 230 CONTINUE + CALL XERMSG ('SLATEC', 'DBINT4', 'IBCR IS NOT 1 OR 2', 2, 1) + RETURN + 240 CONTINUE + CALL XERMSG ('SLATEC', 'DBINT4', 'KNTOPT IS NOT 1, 2, OR 3', 2, + + 1) + RETURN + 250 CONTINUE + CALL XERMSG ('SLATEC', 'DBINT4', + + 'KNOT INPUT THROUGH W ARRAY IS NOT ORDERED PROPERLY', 2, 1) + RETURN + END diff --git a/external/SLATEC/src/dbnfac.f b/external/SLATEC/src/dbnfac.f new file mode 100644 index 0000000..eb61515 --- /dev/null +++ b/external/SLATEC/src/dbnfac.f @@ -0,0 +1,139 @@ +*DECK DBNFAC + SUBROUTINE DBNFAC (W, NROWW, NROW, NBANDL, NBANDU, IFLAG) +C***BEGIN PROLOGUE DBNFAC +C***SUBSIDIARY +C***PURPOSE Subsidiary to DBINT4 and DBINTK +C***LIBRARY SLATEC +C***TYPE DOUBLE PRECISION (BNFAC-S, DBNFAC-D) +C***AUTHOR (UNKNOWN) +C***DESCRIPTION +C +C DBNFAC is the BANFAC routine from +C * A Practical Guide to Splines * by C. de Boor +C +C DBNFAC is a double precision routine +C +C Returns in W the LU-factorization (without pivoting) of the banded +C matrix A of order NROW with (NBANDL + 1 + NBANDU) bands or diag- +C onals in the work array W . +C +C ***** I N P U T ****** W is double precision +C W.....Work array of size (NROWW,NROW) containing the interesting +C part of a banded matrix A , with the diagonals or bands of A +C stored in the rows of W , while columns of A correspond to +C columns of W . This is the storage mode used in LINPACK and +C results in efficient innermost loops. +C Explicitly, A has NBANDL bands below the diagonal +C + 1 (main) diagonal +C + NBANDU bands above the diagonal +C and thus, with MIDDLE = NBANDU + 1, +C A(I+J,J) is in W(I+MIDDLE,J) for I=-NBANDU,...,NBANDL +C J=1,...,NROW . +C For example, the interesting entries of A (1,2)-banded matrix +C of order 9 would appear in the first 1+1+2 = 4 rows of W +C as follows. +C 13 24 35 46 57 68 79 +C 12 23 34 45 56 67 78 89 +C 11 22 33 44 55 66 77 88 99 +C 21 32 43 54 65 76 87 98 +C +C All other entries of W not identified in this way with an en- +C try of A are never referenced . +C NROWW.....Row dimension of the work array W . +C must be .GE. NBANDL + 1 + NBANDU . +C NBANDL.....Number of bands of A below the main diagonal +C NBANDU.....Number of bands of A above the main diagonal . +C +C ***** O U T P U T ****** W is double precision +C IFLAG.....Integer indicating success( = 1) or failure ( = 2) . +C If IFLAG = 1, then +C W.....contains the LU-factorization of A into a unit lower triangu- +C lar matrix L and an upper triangular matrix U (both banded) +C and stored in customary fashion over the corresponding entries +C of A . This makes it possible to solve any particular linear +C system A*X = B for X by a +C CALL DBNSLV ( W, NROWW, NROW, NBANDL, NBANDU, B ) +C with the solution X contained in B on return . +C If IFLAG = 2, then +C one of NROW-1, NBANDL,NBANDU failed to be nonnegative, or else +C one of the potential pivots was found to be zero indicating +C that A does not have an LU-factorization. This implies that +C A is singular in case it is totally positive . +C +C ***** M E T H O D ****** +C Gauss elimination W I T H O U T pivoting is used. The routine is +C intended for use with matrices A which do not require row inter- +C changes during factorization, especially for the T O T A L L Y +C P O S I T I V E matrices which occur in spline calculations. +C The routine should NOT be used for an arbitrary banded matrix. +C +C***SEE ALSO DBINT4, DBINTK +C***ROUTINES CALLED (NONE) +C***REVISION HISTORY (YYMMDD) +C 800901 DATE WRITTEN +C 890531 Changed all specific intrinsics to generic. (WRB) +C 890831 Modified array declarations. (WRB) +C 891214 Prologue converted to Version 4.0 format. (BAB) +C 900328 Added TYPE section. (WRB) +C***END PROLOGUE DBNFAC +C + INTEGER IFLAG, NBANDL, NBANDU, NROW, NROWW, I, IPK, J, JMAX, K, + 1 KMAX, MIDDLE, MIDMK, NROWM1 + DOUBLE PRECISION W(NROWW,*), FACTOR, PIVOT +C +C***FIRST EXECUTABLE STATEMENT DBNFAC + IFLAG = 1 + MIDDLE = NBANDU + 1 +C W(MIDDLE,.) CONTAINS THE MAIN DIAGONAL OF A . + NROWM1 = NROW - 1 + IF (NROWM1) 120, 110, 10 + 10 IF (NBANDL.GT.0) GO TO 30 +C A IS UPPER TRIANGULAR. CHECK THAT DIAGONAL IS NONZERO . + DO 20 I=1,NROWM1 + IF (W(MIDDLE,I).EQ.0.0D0) GO TO 120 + 20 CONTINUE + GO TO 110 + 30 IF (NBANDU.GT.0) GO TO 60 +C A IS LOWER TRIANGULAR. CHECK THAT DIAGONAL IS NONZERO AND +C DIVIDE EACH COLUMN BY ITS DIAGONAL . + DO 50 I=1,NROWM1 + PIVOT = W(MIDDLE,I) + IF (PIVOT.EQ.0.0D0) GO TO 120 + JMAX = MIN(NBANDL,NROW-I) + DO 40 J=1,JMAX + W(MIDDLE+J,I) = W(MIDDLE+J,I)/PIVOT + 40 CONTINUE + 50 CONTINUE + RETURN +C +C A IS NOT JUST A TRIANGULAR MATRIX. CONSTRUCT LU FACTORIZATION + 60 DO 100 I=1,NROWM1 +C W(MIDDLE,I) IS PIVOT FOR I-TH STEP . + PIVOT = W(MIDDLE,I) + IF (PIVOT.EQ.0.0D0) GO TO 120 +C JMAX IS THE NUMBER OF (NONZERO) ENTRIES IN COLUMN I +C BELOW THE DIAGONAL . + JMAX = MIN(NBANDL,NROW-I) +C DIVIDE EACH ENTRY IN COLUMN I BELOW DIAGONAL BY PIVOT . + DO 70 J=1,JMAX + W(MIDDLE+J,I) = W(MIDDLE+J,I)/PIVOT + 70 CONTINUE +C KMAX IS THE NUMBER OF (NONZERO) ENTRIES IN ROW I TO +C THE RIGHT OF THE DIAGONAL . + KMAX = MIN(NBANDU,NROW-I) +C SUBTRACT A(I,I+K)*(I-TH COLUMN) FROM (I+K)-TH COLUMN +C (BELOW ROW I ) . + DO 90 K=1,KMAX + IPK = I + K + MIDMK = MIDDLE - K + FACTOR = W(MIDMK,IPK) + DO 80 J=1,JMAX + W(MIDMK+J,IPK) = W(MIDMK+J,IPK) - W(MIDDLE+J,I)*FACTOR + 80 CONTINUE + 90 CONTINUE + 100 CONTINUE +C CHECK THE LAST DIAGONAL ENTRY . + 110 IF (W(MIDDLE,NROW).NE.0.0D0) RETURN + 120 IFLAG = 2 + RETURN + END diff --git a/external/SLATEC/src/dbnslv.f b/external/SLATEC/src/dbnslv.f new file mode 100644 index 0000000..2bae84b --- /dev/null +++ b/external/SLATEC/src/dbnslv.f @@ -0,0 +1,81 @@ +*DECK DBNSLV + SUBROUTINE DBNSLV (W, NROWW, NROW, NBANDL, NBANDU, B) +C***BEGIN PROLOGUE DBNSLV +C***SUBSIDIARY +C***PURPOSE Subsidiary to DBINT4 and DBINTK +C***LIBRARY SLATEC +C***TYPE DOUBLE PRECISION (BNSLV-S, DBNSLV-D) +C***AUTHOR (UNKNOWN) +C***DESCRIPTION +C +C DBNSLV is the BANSLV routine from +C * A Practical Guide to Splines * by C. de Boor +C +C DBNSLV is a double precision routine +C +C Companion routine to DBNFAC . It returns the solution X of the +C linear system A*X = B in place of B , given the LU-factorization +C for A in the work array W from DBNFAC. +C +C ***** I N P U T ****** W,B are DOUBLE PRECISION +C W, NROWW,NROW,NBANDL,NBANDU.....Describe the LU-factorization of a +C banded matrix A of order NROW as constructed in DBNFAC . +C For details, see DBNFAC . +C B.....Right side of the system to be solved . +C +C ***** O U T P U T ****** B is DOUBLE PRECISION +C B.....Contains the solution X , of order NROW . +C +C ***** M E T H O D ****** +C (With A = L*U, as stored in W,) the unit lower triangular system +C L(U*X) = B is solved for Y = U*X, and Y stored in B . Then the +C upper triangular system U*X = Y is solved for X . The calcul- +C ations are so arranged that the innermost loops stay within columns. +C +C***SEE ALSO DBINT4, DBINTK +C***ROUTINES CALLED (NONE) +C***REVISION HISTORY (YYMMDD) +C 800901 DATE WRITTEN +C 890531 Changed all specific intrinsics to generic. (WRB) +C 890831 Modified array declarations. (WRB) +C 891214 Prologue converted to Version 4.0 format. (BAB) +C 900328 Added TYPE section. (WRB) +C***END PROLOGUE DBNSLV +C + INTEGER NBANDL, NBANDU, NROW, NROWW, I, J, JMAX, MIDDLE, NROWM1 + DOUBLE PRECISION W(NROWW,*), B(*) +C***FIRST EXECUTABLE STATEMENT DBNSLV + MIDDLE = NBANDU + 1 + IF (NROW.EQ.1) GO TO 80 + NROWM1 = NROW - 1 + IF (NBANDL.EQ.0) GO TO 30 +C FORWARD PASS +C FOR I=1,2,...,NROW-1, SUBTRACT RIGHT SIDE(I)*(I-TH COLUMN +C OF L ) FROM RIGHT SIDE (BELOW I-TH ROW) . + DO 20 I=1,NROWM1 + JMAX = MIN(NBANDL,NROW-I) + DO 10 J=1,JMAX + B(I+J) = B(I+J) - B(I)*W(MIDDLE+J,I) + 10 CONTINUE + 20 CONTINUE +C BACKWARD PASS +C FOR I=NROW,NROW-1,...,1, DIVIDE RIGHT SIDE(I) BY I-TH DIAG- +C ONAL ENTRY OF U, THEN SUBTRACT RIGHT SIDE(I)*(I-TH COLUMN +C OF U) FROM RIGHT SIDE (ABOVE I-TH ROW). + 30 IF (NBANDU.GT.0) GO TO 50 +C A IS LOWER TRIANGULAR . + DO 40 I=1,NROW + B(I) = B(I)/W(1,I) + 40 CONTINUE + RETURN + 50 I = NROW + 60 B(I) = B(I)/W(MIDDLE,I) + JMAX = MIN(NBANDU,I-1) + DO 70 J=1,JMAX + B(I-J) = B(I-J) - B(I)*W(MIDDLE-J,I) + 70 CONTINUE + I = I - 1 + IF (I.GT.1) GO TO 60 + 80 B(1) = B(1)/W(MIDDLE,1) + RETURN + END diff --git a/external/SLATEC/src/dbspvd.f b/external/SLATEC/src/dbspvd.f new file mode 100644 index 0000000..99a8fba --- /dev/null +++ b/external/SLATEC/src/dbspvd.f @@ -0,0 +1,162 @@ +*DECK DBSPVD + SUBROUTINE DBSPVD (T, K, NDERIV, X, ILEFT, LDVNIK, VNIKX, WORK) +C***BEGIN PROLOGUE DBSPVD +C***PURPOSE Calculate the value and all derivatives of order less than +C NDERIV of all basis functions which do not vanish at X. +C***LIBRARY SLATEC +C***CATEGORY E3, K6 +C***TYPE DOUBLE PRECISION (BSPVD-S, DBSPVD-D) +C***KEYWORDS DIFFERENTIATION OF B-SPLINE, EVALUATION OF B-SPLINE +C***AUTHOR Amos, D. E., (SNLA) +C***DESCRIPTION +C +C Written by Carl de Boor and modified by D. E. Amos +C +C Abstract **** a double precision routine **** +C +C DBSPVD is the BSPLVD routine of the reference. +C +C DBSPVD calculates the value and all derivatives of order +C less than NDERIV of all basis functions which do not +C (possibly) vanish at X. ILEFT is input such that +C T(ILEFT) .LE. X .LT. T(ILEFT+1). A call to INTRV(T,N+1,X, +C ILO,ILEFT,MFLAG) will produce the proper ILEFT. The output of +C DBSPVD is a matrix VNIKX(I,J) of dimension at least (K,NDERIV) +C whose columns contain the K nonzero basis functions and +C their NDERIV-1 right derivatives at X, I=1,K, J=1,NDERIV. +C These basis functions have indices ILEFT-K+I, I=1,K, +C K .LE. ILEFT .LE. N. The nonzero part of the I-th basis +C function lies in (T(I),T(I+K)), I=1,N). +C +C If X=T(ILEFT+1) then VNIKX contains left limiting values +C (left derivatives) at T(ILEFT+1). In particular, ILEFT = N +C produces left limiting values at the right end point +C X=T(N+1). To obtain left limiting values at T(I), I=K+1,N+1, +C set X= next lower distinct knot, call INTRV to get ILEFT, +C set X=T(I), and then call DBSPVD. +C +C Description of Arguments +C Input T,X are double precision +C T - knot vector of length N+K, where +C N = number of B-spline basis functions +C N = sum of knot multiplicities-K +C K - order of the B-spline, K .GE. 1 +C NDERIV - number of derivatives = NDERIV-1, +C 1 .LE. NDERIV .LE. K +C X - argument of basis functions, +C T(K) .LE. X .LE. T(N+1) +C ILEFT - largest integer such that +C T(ILEFT) .LE. X .LT. T(ILEFT+1) +C LDVNIK - leading dimension of matrix VNIKX +C +C Output VNIKX,WORK are double precision +C VNIKX - matrix of dimension at least (K,NDERIV) contain- +C ing the nonzero basis functions at X and their +C derivatives columnwise. +C WORK - a work vector of length (K+1)*(K+2)/2 +C +C Error Conditions +C Improper input is a fatal error +C +C***REFERENCES Carl de Boor, Package for calculating with B-splines, +C SIAM Journal on Numerical Analysis 14, 3 (June 1977), +C pp. 441-472. +C***ROUTINES CALLED DBSPVN, XERMSG +C***REVISION HISTORY (YYMMDD) +C 800901 DATE WRITTEN +C 890531 Changed all specific intrinsics to generic. (WRB) +C 890831 Modified array declarations. (WRB) +C 890831 REVISION DATE from Version 3.2 +C 891214 Prologue converted to Version 4.0 format. (BAB) +C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) +C 920501 Reformatted the REFERENCES section. (WRB) +C***END PROLOGUE DBSPVD +C + INTEGER I,IDERIV,ILEFT,IPKMD,J,JJ,JLOW,JM,JP1MID,K,KMD, KP1, L, + 1 LDUMMY, M, MHIGH, NDERIV + DOUBLE PRECISION FACTOR, FKMD, T, V, VNIKX, WORK, X +C DIMENSION T(ILEFT+K), WORK((K+1)*(K+2)/2) +C A(I,J) = WORK(I+J*(J+1)/2), I=1,J+1 J=1,K-1 +C A(I,K) = W0RK(I+K*(K-1)/2) I=1.K +C WORK(1) AND WORK((K+1)*(K+2)/2) ARE NOT USED. + DIMENSION T(*), VNIKX(LDVNIK,*), WORK(*) +C***FIRST EXECUTABLE STATEMENT DBSPVD + IF(K.LT.1) GO TO 200 + IF(NDERIV.LT.1 .OR. NDERIV.GT.K) GO TO 205 + IF(LDVNIK.LT.K) GO TO 210 + IDERIV = NDERIV + KP1 = K + 1 + JJ = KP1 - IDERIV + CALL DBSPVN(T, JJ, K, 1, X, ILEFT, VNIKX, WORK, IWORK) + IF (IDERIV.EQ.1) GO TO 100 + MHIGH = IDERIV + DO 20 M=2,MHIGH + JP1MID = 1 + DO 10 J=IDERIV,K + VNIKX(J,IDERIV) = VNIKX(JP1MID,1) + JP1MID = JP1MID + 1 + 10 CONTINUE + IDERIV = IDERIV - 1 + JJ = KP1 - IDERIV + CALL DBSPVN(T, JJ, K, 2, X, ILEFT, VNIKX, WORK, IWORK) + 20 CONTINUE +C + JM = KP1*(KP1+1)/2 + DO 30 L = 1,JM + WORK(L) = 0.0D0 + 30 CONTINUE +C A(I,I) = WORK(I*(I+3)/2) = 1.0 I = 1,K + L = 2 + J = 0 + DO 40 I = 1,K + J = J + L + WORK(J) = 1.0D0 + L = L + 1 + 40 CONTINUE + KMD = K + DO 90 M=2,MHIGH + KMD = KMD - 1 + FKMD = KMD + I = ILEFT + J = K + JJ = J*(J+1)/2 + JM = JJ - J + DO 60 LDUMMY=1,KMD + IPKMD = I + KMD + FACTOR = FKMD/(T(IPKMD)-T(I)) + DO 50 L=1,J + WORK(L+JJ) = (WORK(L+JJ)-WORK(L+JM))*FACTOR + 50 CONTINUE + I = I - 1 + J = J - 1 + JJ = JM + JM = JM - J + 60 CONTINUE +C + DO 80 I=1,K + V = 0.0D0 + JLOW = MAX(I,M) + JJ = JLOW*(JLOW+1)/2 + DO 70 J=JLOW,K + V = WORK(I+JJ)*VNIKX(J,M) + V + JJ = JJ + J + 1 + 70 CONTINUE + VNIKX(I,M) = V + 80 CONTINUE + 90 CONTINUE + 100 RETURN +C +C + 200 CONTINUE + CALL XERMSG ('SLATEC', 'DBSPVD', 'K DOES NOT SATISFY K.GE.1', 2, + + 1) + RETURN + 205 CONTINUE + CALL XERMSG ('SLATEC', 'DBSPVD', + + 'NDERIV DOES NOT SATISFY 1.LE.NDERIV.LE.K', 2, 1) + RETURN + 210 CONTINUE + CALL XERMSG ('SLATEC', 'DBSPVD', + + 'LDVNIK DOES NOT SATISFY LDVNIK.GE.K', 2, 1) + RETURN + END diff --git a/external/SLATEC/src/dbspvn.f b/external/SLATEC/src/dbspvn.f new file mode 100644 index 0000000..027646f --- /dev/null +++ b/external/SLATEC/src/dbspvn.f @@ -0,0 +1,123 @@ +*DECK DBSPVN + SUBROUTINE DBSPVN (T, JHIGH, K, INDEX, X, ILEFT, VNIKX, WORK, + + IWORK) +C***BEGIN PROLOGUE DBSPVN +C***PURPOSE Calculate the value of all (possibly) nonzero basis +C functions at X. +C***LIBRARY SLATEC +C***CATEGORY E3, K6 +C***TYPE DOUBLE PRECISION (BSPVN-S, DBSPVN-D) +C***KEYWORDS EVALUATION OF B-SPLINE +C***AUTHOR Amos, D. E., (SNLA) +C***DESCRIPTION +C +C Written by Carl de Boor and modified by D. E. Amos +C +C Abstract **** a double precision routine **** +C DBSPVN is the BSPLVN routine of the reference. +C +C DBSPVN calculates the value of all (possibly) nonzero basis +C functions at X of order MAX(JHIGH,(J+1)*(INDEX-1)), where T(K) +C .LE. X .LE. T(N+1) and J=IWORK is set inside the routine on +C the first call when INDEX=1. ILEFT is such that T(ILEFT) .LE. +C X .LT. T(ILEFT+1). A call to DINTRV(T,N+1,X,ILO,ILEFT,MFLAG) +C produces the proper ILEFT. DBSPVN calculates using the basic +C algorithm needed in DBSPVD. If only basis functions are +C desired, setting JHIGH=K and INDEX=1 can be faster than +C calling DBSPVD, but extra coding is required for derivatives +C (INDEX=2) and DBSPVD is set up for this purpose. +C +C Left limiting values are set up as described in DBSPVD. +C +C Description of Arguments +C +C Input T,X are double precision +C T - knot vector of length N+K, where +C N = number of B-spline basis functions +C N = sum of knot multiplicities-K +C JHIGH - order of B-spline, 1 .LE. JHIGH .LE. K +C K - highest possible order +C INDEX - INDEX = 1 gives basis functions of order JHIGH +C = 2 denotes previous entry with work, IWORK +C values saved for subsequent calls to +C DBSPVN. +C X - argument of basis functions, +C T(K) .LE. X .LE. T(N+1) +C ILEFT - largest integer such that +C T(ILEFT) .LE. X .LT. T(ILEFT+1) +C +C Output VNIKX, WORK are double precision +C VNIKX - vector of length K for spline values. +C WORK - a work vector of length 2*K +C IWORK - a work parameter. Both WORK and IWORK contain +C information necessary to continue for INDEX = 2. +C When INDEX = 1 exclusively, these are scratch +C variables and can be used for other purposes. +C +C Error Conditions +C Improper input is a fatal error. +C +C***REFERENCES Carl de Boor, Package for calculating with B-splines, +C SIAM Journal on Numerical Analysis 14, 3 (June 1977), +C pp. 441-472. +C***ROUTINES CALLED XERMSG +C***REVISION HISTORY (YYMMDD) +C 800901 DATE WRITTEN +C 890831 Modified array declarations. (WRB) +C 890831 REVISION DATE from Version 3.2 +C 891214 Prologue converted to Version 4.0 format. (BAB) +C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) +C 920501 Reformatted the REFERENCES section. (WRB) +C***END PROLOGUE DBSPVN +C + INTEGER ILEFT, IMJP1, INDEX, IPJ, IWORK, JHIGH, JP1, JP1ML, K, L + DOUBLE PRECISION T, VM, VMPREV, VNIKX, WORK, X +C DIMENSION T(ILEFT+JHIGH) + DIMENSION T(*), VNIKX(*), WORK(*) +C CONTENT OF J, DELTAM, DELTAP IS EXPECTED UNCHANGED BETWEEN CALLS. +C WORK(I) = DELTAP(I), WORK(K+I) = DELTAM(I), I = 1,K +C***FIRST EXECUTABLE STATEMENT DBSPVN + IF(K.LT.1) GO TO 90 + IF(JHIGH.GT.K .OR. JHIGH.LT.1) GO TO 100 + IF(INDEX.LT.1 .OR. INDEX.GT.2) GO TO 105 + IF(X.LT.T(ILEFT) .OR. X.GT.T(ILEFT+1)) GO TO 110 + GO TO (10, 20), INDEX + 10 IWORK = 1 + VNIKX(1) = 1.0D0 + IF (IWORK.GE.JHIGH) GO TO 40 +C + 20 IPJ = ILEFT + IWORK + WORK(IWORK) = T(IPJ) - X + IMJP1 = ILEFT - IWORK + 1 + WORK(K+IWORK) = X - T(IMJP1) + VMPREV = 0.0D0 + JP1 = IWORK + 1 + DO 30 L=1,IWORK + JP1ML = JP1 - L + VM = VNIKX(L)/(WORK(L)+WORK(K+JP1ML)) + VNIKX(L) = VM*WORK(L) + VMPREV + VMPREV = VM*WORK(K+JP1ML) + 30 CONTINUE + VNIKX(JP1) = VMPREV + IWORK = JP1 + IF (IWORK.LT.JHIGH) GO TO 20 +C + 40 RETURN +C +C + 90 CONTINUE + CALL XERMSG ('SLATEC', 'DBSPVN', 'K DOES NOT SATISFY K.GE.1', 2, + + 1) + RETURN + 100 CONTINUE + CALL XERMSG ('SLATEC', 'DBSPVN', + + 'JHIGH DOES NOT SATISFY 1.LE.JHIGH.LE.K', 2, 1) + RETURN + 105 CONTINUE + CALL XERMSG ('SLATEC', 'DBSPVN', 'INDEX IS NOT 1 OR 2', 2, 1) + RETURN + 110 CONTINUE + CALL XERMSG ('SLATEC', 'DBSPVN', + + 'X DOES NOT SATISFY T(ILEFT).LE.X.LE.T(ILEFT+1)', 2, 1) + RETURN + END diff --git a/external/SLATEC/src/dbvalu.f b/external/SLATEC/src/dbvalu.f new file mode 100644 index 0000000..26a8224 --- /dev/null +++ b/external/SLATEC/src/dbvalu.f @@ -0,0 +1,165 @@ +*DECK DBVALU + DOUBLE PRECISION FUNCTION DBVALU (T, A, N, K, IDERIV, X, INBV, + + WORK) +C***BEGIN PROLOGUE DBVALU +C***PURPOSE Evaluate the B-representation of a B-spline at X for the +C function value or any of its derivatives. +C***LIBRARY SLATEC +C***CATEGORY E3, K6 +C***TYPE DOUBLE PRECISION (BVALU-S, DBVALU-D) +C***KEYWORDS DIFFERENTIATION OF B-SPLINE, EVALUATION OF B-SPLINE +C***AUTHOR Amos, D. E., (SNLA) +C***DESCRIPTION +C +C Written by Carl de Boor and modified by D. E. Amos +C +C Abstract **** a double precision routine **** +C DBVALU is the BVALUE function of the reference. +C +C DBVALU evaluates the B-representation (T,A,N,K) of a B-spline +C at X for the function value on IDERIV=0 or any of its +C derivatives on IDERIV=1,2,...,K-1. Right limiting values +C (right derivatives) are returned except at the right end +C point X=T(N+1) where left limiting values are computed. The +C spline is defined on T(K) .LE. X .LE. T(N+1). DBVALU returns +C a fatal error message when X is outside of this interval. +C +C To compute left derivatives or left limiting values at a +C knot T(I), replace N by I-1 and set X=T(I), I=K+1,N+1. +C +C DBVALU calls DINTRV +C +C Description of Arguments +C +C Input T,A,X are double precision +C T - knot vector of length N+K +C A - B-spline coefficient vector of length N +C N - number of B-spline coefficients +C N = sum of knot multiplicities-K +C K - order of the B-spline, K .GE. 1 +C IDERIV - order of the derivative, 0 .LE. IDERIV .LE. K-1 +C IDERIV = 0 returns the B-spline value +C X - argument, T(K) .LE. X .LE. T(N+1) +C INBV - an initialization parameter which must be set +C to 1 the first time DBVALU is called. +C +C Output WORK,DBVALU are double precision +C INBV - INBV contains information for efficient process- +C ing after the initial call and INBV must not +C be changed by the user. Distinct splines require +C distinct INBV parameters. +C WORK - work vector of length 3*K. +C DBVALU - value of the IDERIV-th derivative at X +C +C Error Conditions +C An improper input is a fatal error +C +C***REFERENCES Carl de Boor, Package for calculating with B-splines, +C SIAM Journal on Numerical Analysis 14, 3 (June 1977), +C pp. 441-472. +C***ROUTINES CALLED DINTRV, XERMSG +C***REVISION HISTORY (YYMMDD) +C 800901 DATE WRITTEN +C 890831 Modified array declarations. (WRB) +C 890911 Removed unnecessary intrinsics. (WRB) +C 890911 REVISION DATE from Version 3.2 +C 891214 Prologue converted to Version 4.0 format. (BAB) +C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) +C 920501 Reformatted the REFERENCES section. (WRB) +C***END PROLOGUE DBVALU +C + INTEGER I,IDERIV,IDERP1,IHI,IHMKMJ,ILO,IMK,IMKPJ, INBV, IPJ, + 1 IP1, IP1MJ, J, JJ, J1, J2, K, KMIDER, KMJ, KM1, KPK, MFLAG, N + DOUBLE PRECISION A, FKMJ, T, WORK, X + DIMENSION T(*), A(*), WORK(*) +C***FIRST EXECUTABLE STATEMENT DBVALU + DBVALU = 0.0D0 + IF(K.LT.1) GO TO 102 + IF(N.LT.K) GO TO 101 + IF(IDERIV.LT.0 .OR. IDERIV.GE.K) GO TO 110 + KMIDER = K - IDERIV +C +C *** FIND *I* IN (K,N) SUCH THAT T(I) .LE. X .LT. T(I+1) +C (OR, .LE. T(I+1) IF T(I) .LT. T(I+1) = T(N+1)). + KM1 = K - 1 + CALL DINTRV(T, N+1, X, INBV, I, MFLAG) + IF (X.LT.T(K)) GO TO 120 + IF (MFLAG.EQ.0) GO TO 20 + IF (X.GT.T(I)) GO TO 130 + 10 IF (I.EQ.K) GO TO 140 + I = I - 1 + IF (X.EQ.T(I)) GO TO 10 +C +C *** DIFFERENCE THE COEFFICIENTS *IDERIV* TIMES +C WORK(I) = AJ(I), WORK(K+I) = DP(I), WORK(K+K+I) = DM(I), I=1.K +C + 20 IMK = I - K + DO 30 J=1,K + IMKPJ = IMK + J + WORK(J) = A(IMKPJ) + 30 CONTINUE + IF (IDERIV.EQ.0) GO TO 60 + DO 50 J=1,IDERIV + KMJ = K - J + FKMJ = KMJ + DO 40 JJ=1,KMJ + IHI = I + JJ + IHMKMJ = IHI - KMJ + WORK(JJ) = (WORK(JJ+1)-WORK(JJ))/(T(IHI)-T(IHMKMJ))*FKMJ + 40 CONTINUE + 50 CONTINUE +C +C *** COMPUTE VALUE AT *X* IN (T(I),(T(I+1)) OF IDERIV-TH DERIVATIVE, +C GIVEN ITS RELEVANT B-SPLINE COEFF. IN AJ(1),...,AJ(K-IDERIV). + 60 IF (IDERIV.EQ.KM1) GO TO 100 + IP1 = I + 1 + KPK = K + K + J1 = K + 1 + J2 = KPK + 1 + DO 70 J=1,KMIDER + IPJ = I + J + WORK(J1) = T(IPJ) - X + IP1MJ = IP1 - J + WORK(J2) = X - T(IP1MJ) + J1 = J1 + 1 + J2 = J2 + 1 + 70 CONTINUE + IDERP1 = IDERIV + 1 + DO 90 J=IDERP1,KM1 + KMJ = K - J + ILO = KMJ + DO 80 JJ=1,KMJ + WORK(JJ) = (WORK(JJ+1)*WORK(KPK+ILO)+WORK(JJ) + 1 *WORK(K+JJ))/(WORK(KPK+ILO)+WORK(K+JJ)) + ILO = ILO - 1 + 80 CONTINUE + 90 CONTINUE + 100 DBVALU = WORK(1) + RETURN +C +C + 101 CONTINUE + CALL XERMSG ('SLATEC', 'DBVALU', 'N DOES NOT SATISFY N.GE.K', 2, + + 1) + RETURN + 102 CONTINUE + CALL XERMSG ('SLATEC', 'DBVALU', 'K DOES NOT SATISFY K.GE.1', 2, + + 1) + RETURN + 110 CONTINUE + CALL XERMSG ('SLATEC', 'DBVALU', + + 'IDERIV DOES NOT SATISFY 0.LE.IDERIV.LT.K', 2, 1) + RETURN + 120 CONTINUE + CALL XERMSG ('SLATEC', 'DBVALU', + + 'X IS N0T GREATER THAN OR EQUAL TO T(K)', 2, 1) + RETURN + 130 CONTINUE + CALL XERMSG ('SLATEC', 'DBVALU', + + 'X IS NOT LESS THAN OR EQUAL TO T(N+1)', 2, 1) + RETURN + 140 CONTINUE + CALL XERMSG ('SLATEC', 'DBVALU', + + 'A LEFT LIMITING VALUE CANNOT BE OBTAINED AT T(K)', 2, 1) + RETURN + END diff --git a/external/SLATEC/src/ddeabm.f b/external/SLATEC/src/ddeabm.f new file mode 100644 index 0000000..dca92b6 --- /dev/null +++ b/external/SLATEC/src/ddeabm.f @@ -0,0 +1,688 @@ +*DECK DDEABM + SUBROUTINE DDEABM (DF, NEQ, T, Y, TOUT, INFO, RTOL, ATOL, IDID, + + RWORK, LRW, IWORK, LIW, RPAR, IPAR) +C***BEGIN PROLOGUE DDEABM +C***PURPOSE Solve an initial value problem in ordinary differential +C equations using an Adams-Bashforth method. +C***LIBRARY SLATEC (DEPAC) +C***CATEGORY I1A1B +C***TYPE DOUBLE PRECISION (DEABM-S, DDEABM-D) +C***KEYWORDS ADAMS-BASHFORTH METHOD, DEPAC, INITIAL VALUE PROBLEMS, +C ODE, ORDINARY DIFFERENTIAL EQUATIONS, PREDICTOR-CORRECTOR +C***AUTHOR Shampine, L. F., (SNLA) +C Watts, H. A., (SNLA) +C***DESCRIPTION +C +C This is the Adams code in the package of differential equation +C solvers DEPAC, consisting of the codes DDERKF, DDEABM, and DDEBDF. +C Design of the package was by L. F. Shampine and H. A. Watts. +C It is documented in +C SAND79-2374 , DEPAC - Design of a User Oriented Package of ODE +C Solvers. +C DDEABM is a driver for a modification of the code ODE written by +C L. F. Shampine and M. K. Gordon +C Sandia Laboratories +C Albuquerque, New Mexico 87185 +C +C ********************************************************************** +C * ABSTRACT * +C ************ +C +C Subroutine DDEABM uses the Adams-Bashforth-Moulton +C Predictor-Corrector formulas of orders one through twelve to +C integrate a system of NEQ first order ordinary differential +C equations of the form +C DU/DX = DF(X,U) +C when the vector Y(*) of initial values for U(*) at X=T is given. +C The subroutine integrates from T to TOUT. It is easy to continue the +C integration to get results at additional TOUT. This is the interval +C mode of operation. It is also easy for the routine to return with +C the solution at each intermediate step on the way to TOUT. This is +C the intermediate-output mode of operation. +C +C DDEABM uses subprograms DDES, DSTEPS, DINTP, DHSTRT, DHVNRM, +C D1MACH, and the error handling routine XERMSG. The only machine +C dependent parameters to be assigned appear in D1MACH. +C +C ********************************************************************** +C * Description of The Arguments To DDEABM (An Overview) * +C ********************************************************************** +C +C The Parameters are +C +C DF -- This is the name of a subroutine which you provide to +C define the differential equations. +C +C NEQ -- This is the number of (first order) differential +C equations to be integrated. +C +C T -- This is a DOUBLE PRECISION value of the independent +C variable. +C +C Y(*) -- This DOUBLE PRECISION array contains the solution +C components at T. +C +C TOUT -- This is a DOUBLE PRECISION point at which a solution is +C desired. +C +C INFO(*) -- The basic task of the code is to integrate the +C differential equations from T to TOUT and return an +C answer at TOUT. INFO(*) is an INTEGER array which is used +C to communicate exactly how you want this task to be +C carried out. +C +C RTOL, ATOL -- These DOUBLE PRECISION quantities represent +C relative and absolute error tolerances which you +C provide to indicate how accurately you wish the +C solution to be computed. You may choose them to be +C both scalars or else both vectors. +C +C IDID -- This scalar quantity is an indicator reporting what +C the code did. You must monitor this INTEGER variable to +C decide what action to take next. +C +C RWORK(*), LRW -- RWORK(*) is a DOUBLE PRECISION work array of +C length LRW which provides the code with needed storage +C space. +C +C IWORK(*), LIW -- IWORK(*) is an INTEGER work array of length LIW +C which provides the code with needed storage space and an +C across call flag. +C +C RPAR, IPAR -- These are DOUBLE PRECISION and INTEGER parameter +C arrays which you can use for communication between your +C calling program and the DF subroutine. +C +C Quantities which are used as input items are +C NEQ, T, Y(*), TOUT, INFO(*), +C RTOL, ATOL, RWORK(1), LRW and LIW. +C +C Quantities which may be altered by the code are +C T, Y(*), INFO(1), RTOL, ATOL, +C IDID, RWORK(*) and IWORK(*). +C +C ********************************************************************** +C * INPUT -- What To Do On The First Call To DDEABM * +C ********************************************************************** +C +C The first call of the code is defined to be the start of each new +C problem. Read through the descriptions of all the following items, +C provide sufficient storage space for designated arrays, set +C appropriate variables for the initialization of the problem, and +C give information about how you want the problem to be solved. +C +C +C DF -- Provide a subroutine of the form +C DF(X,U,UPRIME,RPAR,IPAR) +C to define the system of first order differential equations +C which is to be solved. For the given values of X and the +C vector U(*)=(U(1),U(2),...,U(NEQ)) , the subroutine must +C evaluate the NEQ components of the system of differential +C equations DU/DX=DF(X,U) and store the derivatives in the +C array UPRIME(*), that is, UPRIME(I) = * DU(I)/DX * for +C equations I=1,...,NEQ. +C +C Subroutine DF must NOT alter X or U(*). You must declare +C the name df in an external statement in your program that +C calls DDEABM. You must dimension U and UPRIME in DF. +C +C RPAR and IPAR are DOUBLE PRECISION and INTEGER parameter +C arrays which you can use for communication between your +C calling program and subroutine DF. They are not used or +C altered by DDEABM. If you do not need RPAR or IPAR, +C ignore these parameters by treating them as dummy +C arguments. If you do choose to use them, dimension them in +C your calling program and in DF as arrays of appropriate +C length. +C +C NEQ -- Set it to the number of differential equations. +C (NEQ .GE. 1) +C +C T -- Set it to the initial point of the integration. +C You must use a program variable for T because the code +C changes its value. +C +C Y(*) -- Set this vector to the initial values of the NEQ solution +C components at the initial point. You must dimension Y at +C least NEQ in your calling program. +C +C TOUT -- Set it to the first point at which a solution +C is desired. You can take TOUT = T, in which case the code +C will evaluate the derivative of the solution at T and +C return. Integration either forward in T (TOUT .GT. T) or +C backward in T (TOUT .LT. T) is permitted. +C +C The code advances the solution from T to TOUT using +C step sizes which are automatically selected so as to +C achieve the desired accuracy. If you wish, the code will +C return with the solution and its derivative following +C each intermediate step (intermediate-output mode) so that +C you can monitor them, but you still must provide TOUT in +C accord with the basic aim of the code. +C +C The first step taken by the code is a critical one +C because it must reflect how fast the solution changes near +C the initial point. The code automatically selects an +C initial step size which is practically always suitable for +C the problem. By using the fact that the code will not step +C past TOUT in the first step, you could, if necessary, +C restrict the length of the initial step size. +C +C For some problems it may not be permissible to integrate +C past a point TSTOP because a discontinuity occurs there +C or the solution or its derivative is not defined beyond +C TSTOP. When you have declared a TSTOP point (see INFO(4) +C and RWORK(1)), you have told the code not to integrate +C past TSTOP. In this case any TOUT beyond TSTOP is invalid +C input. +C +C INFO(*) -- Use the INFO array to give the code more details about +C how you want your problem solved. This array should be +C dimensioned of length 15 to accommodate other members of +C DEPAC or possible future extensions, though DDEABM uses +C only the first four entries. You must respond to all of +C the following items which are arranged as questions. The +C simplest use of the code corresponds to answering all +C questions as YES ,i.e. setting ALL entries of INFO to 0. +C +C INFO(1) -- This parameter enables the code to initialize +C itself. You must set it to indicate the start of every +C new problem. +C +C **** Is this the first call for this problem ... +C YES -- set INFO(1) = 0 +C NO -- not applicable here. +C See below for continuation calls. **** +C +C INFO(2) -- How much accuracy you want of your solution +C is specified by the error tolerances RTOL and ATOL. +C The simplest use is to take them both to be scalars. +C To obtain more flexibility, they can both be vectors. +C The code must be told your choice. +C +C **** Are both error tolerances RTOL, ATOL scalars ... +C YES -- set INFO(2) = 0 +C and input scalars for both RTOL and ATOL +C NO -- set INFO(2) = 1 +C and input arrays for both RTOL and ATOL **** +C +C INFO(3) -- The code integrates from T in the direction +C of TOUT by steps. If you wish, it will return the +C computed solution and derivative at the next +C intermediate step (the intermediate-output mode) or +C TOUT, whichever comes first. This is a good way to +C proceed if you want to see the behavior of the solution. +C If you must have solutions at a great many specific +C TOUT points, this code will compute them efficiently. +C +C **** Do you want the solution only at +C TOUT (and not at the next intermediate step) ... +C YES -- set INFO(3) = 0 +C NO -- set INFO(3) = 1 **** +C +C INFO(4) -- To handle solutions at a great many specific +C values TOUT efficiently, this code may integrate past +C TOUT and interpolate to obtain the result at TOUT. +C Sometimes it is not possible to integrate beyond some +C point TSTOP because the equation changes there or it is +C not defined past TSTOP. Then you must tell the code +C not to go past. +C +C **** Can the integration be carried out without any +C Restrictions on the independent variable T ... +C YES -- set INFO(4)=0 +C NO -- set INFO(4)=1 +C and define the stopping point TSTOP by +C setting RWORK(1)=TSTOP **** +C +C RTOL, ATOL -- You must assign relative (RTOL) and absolute (ATOL) +C error tolerances to tell the code how accurately you want +C the solution to be computed. They must be defined as +C program variables because the code may change them. You +C have two choices -- +C Both RTOL and ATOL are scalars. (INFO(2)=0) +C Both RTOL and ATOL are vectors. (INFO(2)=1) +C In either case all components must be non-negative. +C +C The tolerances are used by the code in a local error test +C at each step which requires roughly that +C ABS(LOCAL ERROR) .LE. RTOL*ABS(Y)+ATOL +C for each vector component. +C (More specifically, a Euclidean norm is used to measure +C the size of vectors, and the error test uses the magnitude +C of the solution at the beginning of the step.) +C +C The true (global) error is the difference between the true +C solution of the initial value problem and the computed +C approximation. Practically all present day codes, +C including this one, control the local error at each step +C and do not even attempt to control the global error +C directly. Roughly speaking, they produce a solution Y(T) +C which satisfies the differential equations with a +C residual R(T), DY(T)/DT = DF(T,Y(T)) + R(T) , +C and, almost always, R(T) is bounded by the error +C tolerances. Usually, but not always, the true accuracy of +C the computed Y is comparable to the error tolerances. This +C code will usually, but not always, deliver a more accurate +C solution if you reduce the tolerances and integrate again. +C By comparing two such solutions you can get a fairly +C reliable idea of the true error in the solution at the +C bigger tolerances. +C +C Setting ATOL=0.D0 results in a pure relative error test on +C that component. Setting RTOL=0. results in a pure absolute +C error test on that component. A mixed test with non-zero +C RTOL and ATOL corresponds roughly to a relative error +C test when the solution component is much bigger than ATOL +C and to an absolute error test when the solution component +C is smaller than the threshold ATOL. +C +C Proper selection of the absolute error control parameters +C ATOL requires you to have some idea of the scale of the +C solution components. To acquire this information may mean +C that you will have to solve the problem more than once. In +C the absence of scale information, you should ask for some +C relative accuracy in all the components (by setting RTOL +C values non-zero) and perhaps impose extremely small +C absolute error tolerances to protect against the danger of +C a solution component becoming zero. +C +C The code will not attempt to compute a solution at an +C accuracy unreasonable for the machine being used. It will +C advise you if you ask for too much accuracy and inform +C you as to the maximum accuracy it believes possible. +C +C RWORK(*) -- Dimension this DOUBLE PRECISION work array of length +C LRW in your calling program. +C +C RWORK(1) -- If you have set INFO(4)=0, you can ignore this +C optional input parameter. Otherwise you must define a +C stopping point TSTOP by setting RWORK(1) = TSTOP. +C (for some problems it may not be permissible to integrate +C past a point TSTOP because a discontinuity occurs there +C or the solution or its derivative is not defined beyond +C TSTOP.) +C +C LRW -- Set it to the declared length of the RWORK array. +C You must have LRW .GE. 130+21*NEQ +C +C IWORK(*) -- Dimension this INTEGER work array of length LIW in +C your calling program. +C +C LIW -- Set it to the declared length of the IWORK array. +C You must have LIW .GE. 51 +C +C RPAR, IPAR -- These are parameter arrays, of DOUBLE PRECISION and +C INTEGER type, respectively. You can use them for +C communication between your program that calls DDEABM and +C the DF subroutine. They are not used or altered by +C DDEABM. If you do not need RPAR or IPAR, ignore these +C parameters by treating them as dummy arguments. If you do +C choose to use them, dimension them in your calling program +C and in DF as arrays of appropriate length. +C +C ********************************************************************** +C * OUTPUT -- After Any Return From DDEABM * +C ********************************************************************** +C +C The principal aim of the code is to return a computed solution at +C TOUT, although it is also possible to obtain intermediate results +C along the way. To find out whether the code achieved its goal +C or if the integration process was interrupted before the task was +C completed, you must check the IDID parameter. +C +C +C T -- The solution was successfully advanced to the +C output value of T. +C +C Y(*) -- Contains the computed solution approximation at T. +C You may also be interested in the approximate derivative +C of the solution at T. It is contained in +C RWORK(21),...,RWORK(20+NEQ). +C +C IDID -- Reports what the code did +C +C *** Task Completed *** +C Reported by positive values of IDID +C +C IDID = 1 -- A step was successfully taken in the +C intermediate-output mode. The code has not +C yet reached TOUT. +C +C IDID = 2 -- The integration to TOUT was successfully +C completed (T=TOUT) by stepping exactly to TOUT. +C +C IDID = 3 -- The integration to TOUT was successfully +C completed (T=TOUT) by stepping past TOUT. +C Y(*) is obtained by interpolation. +C +C *** Task Interrupted *** +C Reported by negative values of IDID +C +C IDID = -1 -- A large amount of work has been expended. +C (500 steps attempted) +C +C IDID = -2 -- The error tolerances are too stringent. +C +C IDID = -3 -- The local error test cannot be satisfied +C because you specified a zero component in ATOL +C and the corresponding computed solution +C component is zero. Thus, a pure relative error +C test is impossible for this component. +C +C IDID = -4 -- The problem appears to be stiff. +C +C IDID = -5,-6,-7,..,-32 -- Not applicable for this code +C but used by other members of DEPAC or possible +C future extensions. +C +C *** Task Terminated *** +C Reported by the value of IDID=-33 +C +C IDID = -33 -- The code has encountered trouble from which +C it cannot recover. A message is printed +C explaining the trouble and control is returned +C to the calling program. For example, this occurs +C when invalid input is detected. +C +C RTOL, ATOL -- These quantities remain unchanged except when +C IDID = -2. In this case, the error tolerances have been +C increased by the code to values which are estimated to be +C appropriate for continuing the integration. However, the +C reported solution at T was obtained using the input values +C of RTOL and ATOL. +C +C RWORK, IWORK -- Contain information which is usually of no +C interest to the user but necessary for subsequent calls. +C However, you may find use for +C +C RWORK(11)--which contains the step size H to be +C attempted on the next step. +C +C RWORK(12)--if the tolerances have been increased by the +C code (IDID = -2) , they were multiplied by the +C value in RWORK(12). +C +C RWORK(13)--Which contains the current value of the +C independent variable, i.e. the farthest point +C integration has reached. This will be different +C from T only when interpolation has been +C performed (IDID=3). +C +C RWORK(20+I)--Which contains the approximate derivative +C of the solution component Y(I). In DDEABM, it +C is obtained by calling subroutine DF to +C evaluate the differential equation using T and +C Y(*) when IDID=1 or 2, and by interpolation +C when IDID=3. +C +C ********************************************************************** +C * INPUT -- What To Do To Continue The Integration * +C * (calls after the first) * +C ********************************************************************** +C +C This code is organized so that subsequent calls to continue the +C integration involve little (if any) additional effort on your +C part. You must monitor the IDID parameter in order to determine +C what to do next. +C +C Recalling that the principal task of the code is to integrate +C from T to TOUT (the interval mode), usually all you will need +C to do is specify a new TOUT upon reaching the current TOUT. +C +C Do not alter any quantity not specifically permitted below, +C in particular do not alter NEQ, T, Y(*), RWORK(*), IWORK(*) or +C the differential equation in subroutine DF. Any such alteration +C constitutes a new problem and must be treated as such, i.e. +C you must start afresh. +C +C You cannot change from vector to scalar error control or vice +C versa (INFO(2)) but you can change the size of the entries of +C RTOL, ATOL. Increasing a tolerance makes the equation easier +C to integrate. Decreasing a tolerance will make the equation +C harder to integrate and should generally be avoided. +C +C You can switch from the intermediate-output mode to the +C interval mode (INFO(3)) or vice versa at any time. +C +C If it has been necessary to prevent the integration from going +C past a point TSTOP (INFO(4), RWORK(1)), keep in mind that the +C code will not integrate to any TOUT beyond the currently +C specified TSTOP. Once TSTOP has been reached you must change +C the value of TSTOP or set INFO(4)=0. You may change INFO(4) +C or TSTOP at any time but you must supply the value of TSTOP in +C RWORK(1) whenever you set INFO(4)=1. +C +C The parameter INFO(1) is used by the code to indicate the +C beginning of a new problem and to indicate whether integration +C is to be continued. You must input the value INFO(1) = 0 +C when starting a new problem. You must input the value +C INFO(1) = 1 if you wish to continue after an interrupted task. +C Do not set INFO(1) = 0 on a continuation call unless you +C want the code to restart at the current T. +C +C *** Following A Completed Task *** +C If +C IDID = 1, call the code again to continue the integration +C another step in the direction of TOUT. +C +C IDID = 2 or 3, define a new TOUT and call the code again. +C TOUT must be different from T. You cannot change +C the direction of integration without restarting. +C +C *** Following An Interrupted Task *** +C To show the code that you realize the task was +C interrupted and that you want to continue, you +C must take appropriate action and reset INFO(1) = 1 +C If +C IDID = -1, the code has attempted 500 steps. +C If you want to continue, set INFO(1) = 1 and +C call the code again. An additional 500 steps +C will be allowed. +C +C IDID = -2, the error tolerances RTOL, ATOL have been +C increased to values the code estimates appropriate +C for continuing. You may want to change them +C yourself. If you are sure you want to continue +C with relaxed error tolerances, set INFO(1)=1 and +C call the code again. +C +C IDID = -3, a solution component is zero and you set the +C corresponding component of ATOL to zero. If you +C are sure you want to continue, you must first +C alter the error criterion to use positive values +C for those components of ATOL corresponding to zero +C solution components, then set INFO(1)=1 and call +C the code again. +C +C IDID = -4, the problem appears to be stiff. It is very +C inefficient to solve such problems with DDEABM. +C The code DDEBDF in DEPAC handles this task +C efficiently. If you are absolutely sure you want +C to continue with DDEABM, set INFO(1)=1 and call +C the code again. +C +C IDID = -5,-6,-7,..,-32 --- cannot occur with this code +C but used by other members of DEPAC or possible +C future extensions. +C +C *** Following A Terminated Task *** +C If +C IDID = -33, you cannot continue the solution of this +C problem. An attempt to do so will result in your +C run being terminated. +C +C ********************************************************************** +C *Long Description: +C +C ********************************************************************** +C * DEPAC Package Overview * +C ********************************************************************** +C +C .... You have a choice of three differential equation solvers from +C .... DEPAC. The following brief descriptions are meant to aid you in +C .... choosing the most appropriate code for your problem. +C +C .... DDERKF is a fifth order Runge-Kutta code. It is the simplest of +C .... the three choices, both algorithmically and in the use of the +C .... code. DDERKF is primarily designed to solve non-stiff and +C .... mildly stiff differential equations when derivative evaluations +C .... are not expensive. It should generally not be used to get high +C .... accuracy results nor answers at a great many specific points. +C .... Because DDERKF has very low overhead costs, it will usually +C .... result in the least expensive integration when solving +C .... problems requiring a modest amount of accuracy and having +C .... equations that are not costly to evaluate. DDERKF attempts to +C .... discover when it is not suitable for the task posed. +C +C .... DDEABM is a variable order (one through twelve) Adams code. +C .... Its complexity lies somewhere between that of DDERKF and +C .... DDEBDF. DDEABM is primarily designed to solve non-stiff and +C .... mildly stiff differential equations when derivative evaluations +C .... are expensive, high accuracy results are needed or answers at +C .... many specific points are required. DDEABM attempts to discover +C .... when it is not suitable for the task posed. +C +C .... DDEBDF is a variable order (one through five) backward +C .... differentiation formula code. it is the most complicated of +C .... the three choices. DDEBDF is primarily designed to solve stiff +C .... differential equations at crude to moderate tolerances. +C .... If the problem is very stiff at all, DDERKF and DDEABM will be +C .... quite inefficient compared to DDEBDF. However, DDEBDF will be +C .... inefficient compared to DDERKF and DDEABM on non-stiff problems +C .... because it uses much more storage, has a much larger overhead, +C .... and the low order formulas will not give high accuracies +C .... efficiently. +C +C .... The concept of stiffness cannot be described in a few words. +C .... If you do not know the problem to be stiff, try either DDERKF +C .... or DDEABM. Both of these codes will inform you of stiffness +C .... when the cost of solving such problems becomes important. +C +C ********************************************************************* +C +C***REFERENCES L. F. Shampine and H. A. Watts, DEPAC - design of a user +C oriented package of ODE solvers, Report SAND79-2374, +C Sandia Laboratories, 1979. +C***ROUTINES CALLED DDES, XERMSG +C***REVISION HISTORY (YYMMDD) +C 820301 DATE WRITTEN +C 890531 Changed all specific intrinsics to generic. (WRB) +C 890831 Modified array declarations. (WRB) +C 891006 Cosmetic changes to prologue. (WRB) +C 891024 Changed references from DVNORM to DHVNRM. (WRB) +C 891024 REVISION DATE from Version 3.2 +C 891214 Prologue converted to Version 4.0 format. (BAB) +C 900510 Convert XERRWV calls to XERMSG calls. (RWC) +C 920501 Reformatted the REFERENCES section. (WRB) +C***END PROLOGUE DDEABM +C + INTEGER IALPHA, IBETA, IDELSN, IDID, IFOURU, IG, IHOLD, + 1 INFO, IP, IPAR, IPHI, IPSI, ISIG, ITOLD, ITSTAR, ITWOU, + 2 IV, IW, IWORK, IWT, IYP, IYPOUT, IYY, LIW, LRW, NEQ + DOUBLE PRECISION ATOL, RPAR, RTOL, RWORK, T, TOUT, Y + LOGICAL START,PHASE1,NORND,STIFF,INTOUT +C + DIMENSION Y(*),INFO(15),RTOL(*),ATOL(*),RWORK(*),IWORK(*), + 1 RPAR(*),IPAR(*) +C + CHARACTER*8 XERN1 + CHARACTER*16 XERN3 +C + EXTERNAL DF +C +C CHECK FOR AN APPARENT INFINITE LOOP +C +C***FIRST EXECUTABLE STATEMENT DDEABM + IF ( INFO(1) .EQ. 0 ) IWORK(LIW) = 0 + IF (IWORK(LIW) .GE. 5) THEN + IF (T .EQ. RWORK(21 + NEQ)) THEN + WRITE (XERN3, '(1PE15.6)') T + CALL XERMSG ('SLATEC', 'DDEABM', + * 'AN APPARENT INFINITE LOOP HAS BEEN DETECTED.$$' // + * 'YOU HAVE MADE REPEATED CALLS AT T = ' // XERN3 // + * ' AND THE INTEGRATION HAS NOT ADVANCED. CHECK THE ' // + * 'WAY YOU HAVE SET PARAMETERS FOR THE CALL TO THE ' // + * 'CODE, PARTICULARLY INFO(1).', 13, 2) + RETURN + ENDIF + ENDIF +C +C CHECK LRW AND LIW FOR SUFFICIENT STORAGE ALLOCATION +C + IDID=0 + IF (LRW .LT. 130+21*NEQ) THEN + WRITE (XERN1, '(I8)') LRW + CALL XERMSG ('SLATEC', 'DDEABM', 'THE LENGTH OF THE RWORK ' // + * 'ARRAY MUST BE AT LEAST 130 + 21*NEQ.$$' // + * 'YOU HAVE CALLED THE CODE WITH LRW = ' // XERN1, 1, 1) + IDID=-33 + ENDIF +C + IF (LIW .LT. 51) THEN + WRITE (XERN1, '(I8)') LIW + CALL XERMSG ('SLATEC', 'DDEABM', 'THE LENGTH OF THE IWORK ' // + * 'ARRAY MUST BE AT LEAST 51.$$YOU HAVE CALLED THE CODE ' // + * 'WITH LIW = ' // XERN1, 2, 1) + IDID=-33 + ENDIF +C +C COMPUTE THE INDICES FOR THE ARRAYS TO BE STORED IN THE WORK ARRAY +C + IYPOUT = 21 + ITSTAR = NEQ + 21 + IYP = 1 + ITSTAR + IYY = NEQ + IYP + IWT = NEQ + IYY + IP = NEQ + IWT + IPHI = NEQ + IP + IALPHA = (NEQ*16) + IPHI + IBETA = 12 + IALPHA + IPSI = 12 + IBETA + IV = 12 + IPSI + IW = 12 + IV + ISIG = 12 + IW + IG = 13 + ISIG + IGI = 13 + IG + IXOLD = 11 + IGI + IHOLD = 1 + IXOLD + ITOLD = 1 + IHOLD + IDELSN = 1 + ITOLD + ITWOU = 1 + IDELSN + IFOURU = 1 + ITWOU +C + RWORK(ITSTAR) = T + IF (INFO(1) .EQ. 0) GO TO 50 + START = IWORK(21) .NE. (-1) + PHASE1 = IWORK(22) .NE. (-1) + NORND = IWORK(23) .NE. (-1) + STIFF = IWORK(24) .NE. (-1) + INTOUT = IWORK(25) .NE. (-1) +C + 50 CALL DDES(DF,NEQ,T,Y,TOUT,INFO,RTOL,ATOL,IDID,RWORK(IYPOUT), + 1 RWORK(IYP),RWORK(IYY),RWORK(IWT),RWORK(IP),RWORK(IPHI), + 2 RWORK(IALPHA),RWORK(IBETA),RWORK(IPSI),RWORK(IV), + 3 RWORK(IW),RWORK(ISIG),RWORK(IG),RWORK(IGI),RWORK(11), + 4 RWORK(12),RWORK(13),RWORK(IXOLD),RWORK(IHOLD), + 5 RWORK(ITOLD),RWORK(IDELSN),RWORK(1),RWORK(ITWOU), + 5 RWORK(IFOURU),START,PHASE1,NORND,STIFF,INTOUT,IWORK(26), + 6 IWORK(27),IWORK(28),IWORK(29),IWORK(30),IWORK(31), + 7 IWORK(32),IWORK(33),IWORK(34),IWORK(35),IWORK(45), + 8 RPAR,IPAR) +C + IWORK(21) = -1 + IF (START) IWORK(21) = 1 + IWORK(22) = -1 + IF (PHASE1) IWORK(22) = 1 + IWORK(23) = -1 + IF (NORND) IWORK(23) = 1 + IWORK(24) = -1 + IF (STIFF) IWORK(24) = 1 + IWORK(25) = -1 + IF (INTOUT) IWORK(25) = 1 +C + IF (IDID .NE. (-2)) IWORK(LIW) = IWORK(LIW) + 1 + IF (T .NE. RWORK(ITSTAR)) IWORK(LIW) = 0 +C + RETURN + END diff --git a/external/SLATEC/src/ddes.f b/external/SLATEC/src/ddes.f new file mode 100644 index 0000000..b883381 --- /dev/null +++ b/external/SLATEC/src/ddes.f @@ -0,0 +1,430 @@ +*DECK DDES + SUBROUTINE DDES (DF, NEQ, T, Y, TOUT, INFO, RTOL, ATOL, IDID, + + YPOUT, YP, YY, WT, P, PHI, ALPHA, BETA, PSI, V, W, SIG, G, GI, + + H, EPS, X, XOLD, HOLD, TOLD, DELSGN, TSTOP, TWOU, FOURU, START, + + PHASE1, NORND, STIFF, INTOUT, NS, KORD, KOLD, INIT, KSTEPS, + + KLE4, IQUIT, KPREV, IVC, IV, KGI, RPAR, IPAR) +C***BEGIN PROLOGUE DDES +C***SUBSIDIARY +C***PURPOSE Subsidiary to DDEABM +C***LIBRARY SLATEC +C***TYPE DOUBLE PRECISION (DES-S, DDES-D) +C***AUTHOR Watts, H. A., (SNLA) +C***DESCRIPTION +C +C DDEABM merely allocates storage for DDES to relieve the user of the +C inconvenience of a long call list. Consequently DDES is used as +C described in the comments for DDEABM . +C +C***SEE ALSO DDEABM +C***ROUTINES CALLED D1MACH, DINTP, DSTEPS, XERMSG +C***REVISION HISTORY (YYMMDD) +C 820301 DATE WRITTEN +C 890531 Changed all specific intrinsics to generic. (WRB) +C 890831 Modified array declarations. (WRB) +C 891214 Prologue converted to Version 4.0 format. (BAB) +C 900328 Added TYPE section. (WRB) +C 900510 Convert XERRWV calls to XERMSG calls, cvt GOTOs to +C IF-THEN-ELSE. (RWC) +C 910722 Updated AUTHOR section. (ALS) +C***END PROLOGUE DDES +C + INTEGER IDID, INFO, INIT, IPAR, IQUIT, IV, IVC, K, KGI, KLE4, + 1 KOLD, KORD, KPREV, KSTEPS, L, LTOL, MAXNUM, NATOLP, NEQ, + 2 NRTOLP, NS + DOUBLE PRECISION A, ABSDEL, ALPHA, ATOL, BETA, D1MACH, + 1 DEL, DELSGN, DT, EPS, FOURU, G, GI, H, + 2 HA, HOLD, P, PHI, PSI, RPAR, RTOL, SIG, T, TOLD, TOUT, + 3 TSTOP, TWOU, U, V, W, WT, X, XOLD, Y, YP, YPOUT, YY + LOGICAL STIFF,CRASH,START,PHASE1,NORND,INTOUT +C + DIMENSION Y(*),YY(*),WT(*),PHI(NEQ,16),P(*),YP(*), + 1 YPOUT(*),PSI(12),ALPHA(12),BETA(12),SIG(13),V(12),W(12),G(13), + 2 GI(11),IV(10),INFO(15),RTOL(*),ATOL(*),RPAR(*),IPAR(*) + CHARACTER*8 XERN1 + CHARACTER*16 XERN3, XERN4 +C + EXTERNAL DF +C +C....................................................................... +C +C THE EXPENSE OF SOLVING THE PROBLEM IS MONITORED BY COUNTING THE +C NUMBER OF STEPS ATTEMPTED. WHEN THIS EXCEEDS MAXNUM, THE COUNTER +C IS RESET TO ZERO AND THE USER IS INFORMED ABOUT POSSIBLE EXCESSIVE +C WORK. +C + SAVE MAXNUM + DATA MAXNUM/500/ +C +C....................................................................... +C +C***FIRST EXECUTABLE STATEMENT DDES + IF (INFO(1) .EQ. 0) THEN +C +C ON THE FIRST CALL , PERFORM INITIALIZATION -- +C DEFINE THE MACHINE UNIT ROUNDOFF QUANTITY U BY CALLING THE +C FUNCTION ROUTINE D1MACH. THE USER MUST MAKE SURE THAT THE +C VALUES SET IN D1MACH ARE RELEVANT TO THE COMPUTER BEING USED. +C + U=D1MACH(4) +C -- SET ASSOCIATED MACHINE DEPENDENT PARAMETERS + TWOU=2.D0*U + FOURU=4.D0*U +C -- SET TERMINATION FLAG + IQUIT=0 +C -- SET INITIALIZATION INDICATOR + INIT=0 +C -- SET COUNTER FOR ATTEMPTED STEPS + KSTEPS=0 +C -- SET INDICATOR FOR INTERMEDIATE-OUTPUT + INTOUT= .FALSE. +C -- SET INDICATOR FOR STIFFNESS DETECTION + STIFF= .FALSE. +C -- SET STEP COUNTER FOR STIFFNESS DETECTION + KLE4=0 +C -- SET INDICATORS FOR STEPS CODE + START= .TRUE. + PHASE1= .TRUE. + NORND= .TRUE. +C -- RESET INFO(1) FOR SUBSEQUENT CALLS + INFO(1)=1 + ENDIF +C +C....................................................................... +C +C CHECK VALIDITY OF INPUT PARAMETERS ON EACH ENTRY +C + IF (INFO(1) .NE. 0 .AND. INFO(1) .NE. 1) THEN + WRITE (XERN1, '(I8)') INFO(1) + CALL XERMSG ('SLATEC', 'DDES', 'IN DDEABM, INFO(1) MUST BE ' // + * 'SET TO 0 FOR THE START OF A NEW PROBLEM, AND MUST BE ' // + * 'SET TO 1 FOLLOWING AN INTERRUPTED TASK. YOU ARE ' // + * 'ATTEMPTING TO CONTINUE THE INTEGRATION ILLEGALLY BY ' // + * 'CALLING THE CODE WITH INFO(1) = ' // XERN1, 3, 1) + IDID=-33 + ENDIF +C + IF (INFO(2) .NE. 0 .AND. INFO(2) .NE. 1) THEN + WRITE (XERN1, '(I8)') INFO(2) + CALL XERMSG ('SLATEC', 'DDES', 'IN DDEABM, INFO(2) MUST BE ' // + * '0 OR 1 INDICATING SCALAR AND VECTOR ERROR TOLERANCES, ' // + * 'RESPECTIVELY. YOU HAVE CALLED THE CODE WITH INFO(2) = ' // + * XERN1, 4, 1) + IDID=-33 + ENDIF +C + IF (INFO(3) .NE. 0 .AND. INFO(3) .NE. 1) THEN + WRITE (XERN1, '(I8)') INFO(3) + CALL XERMSG ('SLATEC', 'DDES', 'IN DDEABM, INFO(3) MUST BE ' // + * '0 OR 1 INDICATING THE INTERVAL OR INTERMEDIATE-OUTPUT ' // + * 'MODE OF INTEGRATION, RESPECTIVELY. YOU HAVE CALLED ' // + * 'THE CODE WITH INFO(3) = ' // XERN1, 5, 1) + IDID=-33 + ENDIF +C + IF (INFO(4) .NE. 0 .AND. INFO(4) .NE. 1) THEN + WRITE (XERN1, '(I8)') INFO(4) + CALL XERMSG ('SLATEC', 'DDES', 'IN DDEABM, INFO(4) MUST BE ' // + * '0 OR 1 INDICATING WHETHER OR NOT THE INTEGRATION ' // + * 'INTERVAL IS TO BE RESTRICTED BY A POINT TSTOP. YOU ' // + * 'HAVE CALLED THE CODE WITH INFO(4) = ' // XERN1, 14, 1) + IDID=-33 + ENDIF +C + IF (NEQ .LT. 1) THEN + WRITE (XERN1, '(I8)') NEQ + CALL XERMSG ('SLATEC', 'DDES', 'IN DDEABM, THE NUMBER OF ' // + * 'EQUATIONS NEQ MUST BE A POSITIVE INTEGER. YOU HAVE ' // + * 'CALLED THE CODE WITH NEQ = ' // XERN1, 6, 1) + IDID=-33 + ENDIF +C + NRTOLP = 0 + NATOLP = 0 + DO 90 K=1,NEQ + IF (NRTOLP .EQ. 0 .AND. RTOL(K) .LT. 0.D0) THEN + WRITE (XERN1, '(I8)') K + WRITE (XERN3, '(1PE15.6)') RTOL(K) + CALL XERMSG ('SLATEC', 'DDES', 'IN DDEABM, THE RELATIVE ' // + * 'ERROR TOLERANCES RTOL MUST BE NON-NEGATIVE. YOU ' // + * 'HAVE CALLED THE CODE WITH RTOL(' // XERN1 // ') = ' // + * XERN3 // '. IN THE CASE OF VECTOR ERROR TOLERANCES, ' // + * 'NO FURTHER CHECKING OF RTOL COMPONENTS IS DONE.', 7, 1) + IDID = -33 + NRTOLP = 1 + ENDIF +C + IF (NATOLP .EQ. 0 .AND. ATOL(K) .LT. 0.D0) THEN + WRITE (XERN1, '(I8)') K + WRITE (XERN3, '(1PE15.6)') ATOL(K) + CALL XERMSG ('SLATEC', 'DDES', 'IN DDEABM, THE ABSOLUTE ' // + * 'ERROR TOLERANCES ATOL MUST BE NON-NEGATIVE. YOU ' // + * 'HAVE CALLED THE CODE WITH ATOL(' // XERN1 // ') = ' // + * XERN3 // '. IN THE CASE OF VECTOR ERROR TOLERANCES, ' // + * 'NO FURTHER CHECKING OF ATOL COMPONENTS IS DONE.', 8, 1) + IDID = -33 + NATOLP = 1 + ENDIF +C + IF (INFO(2) .EQ. 0) GO TO 100 + IF (NATOLP.GT.0 .AND. NRTOLP.GT.0) GO TO 100 + 90 CONTINUE +C + 100 IF (INFO(4) .EQ. 1) THEN + IF (SIGN(1.D0,TOUT-T) .NE. SIGN(1.D0,TSTOP-T) + 1 .OR. ABS(TOUT-T) .GT. ABS(TSTOP-T)) THEN + WRITE (XERN3, '(1PE15.6)') TOUT + WRITE (XERN4, '(1PE15.6)') TSTOP + CALL XERMSG ('SLATEC', 'DDES', 'IN DDEABM, YOU HAVE ' // + * 'CALLED THE CODE WITH TOUT = ' // XERN3 // ' BUT ' // + * 'YOU HAVE ALSO TOLD THE CODE (INFO(4) = 1) NOT TO ' // + * 'INTEGRATE PAST THE POINT TSTOP = ' // XERN4 // + * ' THESE INSTRUCTIONS CONFLICT.', 14, 1) + IDID=-33 + ENDIF + ENDIF +C +C CHECK SOME CONTINUATION POSSIBILITIES +C + IF (INIT .NE. 0) THEN + IF (T .EQ. TOUT) THEN + WRITE (XERN3, '(1PE15.6)') T + CALL XERMSG ('SLATEC', 'DDES', 'IN DDEABM, YOU HAVE ' // + * 'CALLED THE CODE WITH T = TOUT = ' // XERN3 // + * '$$THIS IS NOT ALLOWED ON CONTINUATION CALLS.', 9, 1) + IDID=-33 + ENDIF +C + IF (T .NE. TOLD) THEN + WRITE (XERN3, '(1PE15.6)') TOLD + WRITE (XERN4, '(1PE15.6)') T + CALL XERMSG ('SLATEC', 'DDES', 'IN DDEABM, YOU HAVE ' // + * 'CHANGED THE VALUE OF T FROM ' // XERN3 // ' TO ' // + * XERN4 //' THIS IS NOT ALLOWED ON CONTINUATION CALLS.', + * 10, 1) + IDID=-33 + ENDIF +C + IF (INIT .NE. 1) THEN + IF (DELSGN*(TOUT-T) .LT. 0.D0) THEN + WRITE (XERN3, '(1PE15.6)') TOUT + CALL XERMSG ('SLATEC', 'DDES', 'IN DDEABM, BY ' // + * 'CALLING THE CODE WITH TOUT = ' // XERN3 // + * ' YOU ARE ATTEMPTING TO CHANGE THE DIRECTION OF ' // + * 'INTEGRATION.$$THIS IS NOT ALLOWED WITHOUT ' // + * 'RESTARTING.', 11, 1) + IDID=-33 + ENDIF + ENDIF + ENDIF +C +C INVALID INPUT DETECTED +C + IF (IDID .EQ. (-33)) THEN + IF (IQUIT .NE. (-33)) THEN + IQUIT = -33 + INFO(1) = -1 + ELSE + CALL XERMSG ('SLATEC', 'DDES', 'IN DDEABM, INVALID ' // + * 'INPUT WAS DETECTED ON SUCCESSIVE ENTRIES. IT IS ' // + * 'IMPOSSIBLE TO PROCEED BECAUSE YOU HAVE NOT ' // + * 'CORRECTED THE PROBLEM, SO EXECUTION IS BEING ' // + * 'TERMINATED.', 12, 2) + ENDIF + RETURN + ENDIF +C +C....................................................................... +C +C RTOL = ATOL = 0. IS ALLOWED AS VALID INPUT AND INTERPRETED AS +C ASKING FOR THE MOST ACCURATE SOLUTION POSSIBLE. IN THIS CASE, +C THE RELATIVE ERROR TOLERANCE RTOL IS RESET TO THE SMALLEST VALUE +C FOURU WHICH IS LIKELY TO BE REASONABLE FOR THIS METHOD AND MACHINE +C + DO 180 K=1,NEQ + IF (RTOL(K)+ATOL(K) .GT. 0.D0) GO TO 170 + RTOL(K)=FOURU + IDID=-2 + 170 IF (INFO(2) .EQ. 0) GO TO 190 + 180 CONTINUE +C + 190 IF (IDID .NE. (-2)) GO TO 200 +C RTOL=ATOL=0 ON INPUT, SO RTOL IS CHANGED TO A +C SMALL POSITIVE VALUE + INFO(1)=-1 + RETURN +C +C BRANCH ON STATUS OF INITIALIZATION INDICATOR +C INIT=0 MEANS INITIAL DERIVATIVES AND NOMINAL STEP SIZE +C AND DIRECTION NOT YET SET +C INIT=1 MEANS NOMINAL STEP SIZE AND DIRECTION NOT YET SET +C INIT=2 MEANS NO FURTHER INITIALIZATION REQUIRED +C + 200 IF (INIT .EQ. 0) GO TO 210 + IF (INIT .EQ. 1) GO TO 220 + GO TO 240 +C +C....................................................................... +C +C MORE INITIALIZATION -- +C -- EVALUATE INITIAL DERIVATIVES +C + 210 INIT=1 + A=T + CALL DF(A,Y,YP,RPAR,IPAR) + IF (T .NE. TOUT) GO TO 220 + IDID=2 + DO 215 L = 1,NEQ + 215 YPOUT(L) = YP(L) + TOLD=T + RETURN +C +C -- SET INDEPENDENT AND DEPENDENT VARIABLES +C X AND YY(*) FOR STEPS +C -- SET SIGN OF INTEGRATION DIRECTION +C -- INITIALIZE THE STEP SIZE +C + 220 INIT = 2 + X = T + DO 230 L = 1,NEQ + 230 YY(L) = Y(L) + DELSGN = SIGN(1.0D0,TOUT-T) + H = SIGN(MAX(FOURU*ABS(X),ABS(TOUT-X)),TOUT-X) +C +C....................................................................... +C +C ON EACH CALL SET INFORMATION WHICH DETERMINES THE ALLOWED INTERVAL +C OF INTEGRATION BEFORE RETURNING WITH AN ANSWER AT TOUT +C + 240 DEL = TOUT - T + ABSDEL = ABS(DEL) +C +C....................................................................... +C +C IF ALREADY PAST OUTPUT POINT, INTERPOLATE AND RETURN +C + 250 IF(ABS(X-T) .LT. ABSDEL) GO TO 260 + CALL DINTP(X,YY,TOUT,Y,YPOUT,NEQ,KOLD,PHI,IVC,IV,KGI,GI, + 1 ALPHA,G,W,XOLD,P) + IDID = 3 + IF (X .NE. TOUT) GO TO 255 + IDID = 2 + INTOUT = .FALSE. + 255 T = TOUT + TOLD = T + RETURN +C +C IF CANNOT GO PAST TSTOP AND SUFFICIENTLY CLOSE, +C EXTRAPOLATE AND RETURN +C + 260 IF (INFO(4) .NE. 1) GO TO 280 + IF (ABS(TSTOP-X) .GE. FOURU*ABS(X)) GO TO 280 + DT = TOUT - X + DO 270 L = 1,NEQ + 270 Y(L) = YY(L) + DT*YP(L) + CALL DF(TOUT,Y,YPOUT,RPAR,IPAR) + IDID = 3 + T = TOUT + TOLD = T + RETURN +C + 280 IF (INFO(3) .EQ. 0 .OR. .NOT.INTOUT) GO TO 300 +C +C INTERMEDIATE-OUTPUT MODE +C + IDID = 1 + DO 290 L = 1,NEQ + Y(L)=YY(L) + 290 YPOUT(L) = YP(L) + T = X + TOLD = T + INTOUT = .FALSE. + RETURN +C +C....................................................................... +C +C MONITOR NUMBER OF STEPS ATTEMPTED +C + 300 IF (KSTEPS .LE. MAXNUM) GO TO 330 +C +C A SIGNIFICANT AMOUNT OF WORK HAS BEEN EXPENDED + IDID=-1 + KSTEPS=0 + IF (.NOT. STIFF) GO TO 310 +C +C PROBLEM APPEARS TO BE STIFF + IDID=-4 + STIFF= .FALSE. + KLE4=0 +C + 310 DO 320 L = 1,NEQ + Y(L) = YY(L) + 320 YPOUT(L) = YP(L) + T = X + TOLD = T + INFO(1) = -1 + INTOUT = .FALSE. + RETURN +C +C....................................................................... +C +C LIMIT STEP SIZE, SET WEIGHT VECTOR AND TAKE A STEP +C + 330 HA = ABS(H) + IF (INFO(4) .NE. 1) GO TO 340 + HA = MIN(HA,ABS(TSTOP-X)) + 340 H = SIGN(HA,H) + EPS = 1.0D0 + LTOL = 1 + DO 350 L = 1,NEQ + IF (INFO(2) .EQ. 1) LTOL = L + WT(L) = RTOL(LTOL)*ABS(YY(L)) + ATOL(LTOL) + IF (WT(L) .LE. 0.0D0) GO TO 360 + 350 CONTINUE + GO TO 380 +C +C RELATIVE ERROR CRITERION INAPPROPRIATE + 360 IDID = -3 + DO 370 L = 1,NEQ + Y(L) = YY(L) + 370 YPOUT(L) = YP(L) + T = X + TOLD = T + INFO(1) = -1 + INTOUT = .FALSE. + RETURN +C + 380 CALL DSTEPS(DF,NEQ,YY,X,H,EPS,WT,START,HOLD,KORD,KOLD,CRASH,PHI,P, + 1 YP,PSI,ALPHA,BETA,SIG,V,W,G,PHASE1,NS,NORND,KSTEPS, + 2 TWOU,FOURU,XOLD,KPREV,IVC,IV,KGI,GI,RPAR,IPAR) +C +C....................................................................... +C + IF(.NOT.CRASH) GO TO 420 +C +C TOLERANCES TOO SMALL + IDID = -2 + RTOL(1) = EPS*RTOL(1) + ATOL(1) = EPS*ATOL(1) + IF (INFO(2) .EQ. 0) GO TO 400 + DO 390 L = 2,NEQ + RTOL(L) = EPS*RTOL(L) + 390 ATOL(L) = EPS*ATOL(L) + 400 DO 410 L = 1,NEQ + Y(L) = YY(L) + 410 YPOUT(L) = YP(L) + T = X + TOLD = T + INFO(1) = -1 + INTOUT = .FALSE. + RETURN +C +C (STIFFNESS TEST) COUNT NUMBER OF CONSECUTIVE STEPS TAKEN WITH THE +C ORDER OF THE METHOD BEING LESS OR EQUAL TO FOUR +C + 420 KLE4 = KLE4 + 1 + IF(KOLD .GT. 4) KLE4 = 0 + IF(KLE4 .GE. 50) STIFF = .TRUE. + INTOUT = .TRUE. + GO TO 250 + END diff --git a/external/SLATEC/src/dhstrt.f b/external/SLATEC/src/dhstrt.f new file mode 100644 index 0000000..965d7ec --- /dev/null +++ b/external/SLATEC/src/dhstrt.f @@ -0,0 +1,350 @@ +*DECK DHSTRT + SUBROUTINE DHSTRT (DF, NEQ, A, B, Y, YPRIME, ETOL, MORDER, SMALL, + + BIG, SPY, PV, YP, SF, RPAR, IPAR, H) +C***BEGIN PROLOGUE DHSTRT +C***SUBSIDIARY +C***PURPOSE Subsidiary to DDEABM, DDEBDF and DDERKF +C***LIBRARY SLATEC +C***TYPE DOUBLE PRECISION (HSTART-S, DHSTRT-D) +C***AUTHOR Watts, H. A., (SNLA) +C***DESCRIPTION +C +C DHSTRT computes a starting step size to be used in solving initial +C value problems in ordinary differential equations. +C +C ********************************************************************** +C ABSTRACT +C +C Subroutine DHSTRT computes a starting step size to be used by an +C initial value method in solving ordinary differential equations. +C It is based on an estimate of the local Lipschitz constant for the +C differential equation (lower bound on a norm of the Jacobian) , +C a bound on the differential equation (first derivative) , and +C a bound on the partial derivative of the equation with respect to +C the independent variable. +C (all approximated near the initial point A) +C +C Subroutine DHSTRT uses a function subprogram DHVNRM for computing +C a vector norm. The maximum norm is presently utilized though it +C can easily be replaced by any other vector norm. It is presumed +C that any replacement norm routine would be carefully coded to +C prevent unnecessary underflows or overflows from occurring, and +C also, would not alter the vector or number of components. +C +C ********************************************************************** +C On input you must provide the following +C +C DF -- This is a subroutine of the form +C DF(X,U,UPRIME,RPAR,IPAR) +C which defines the system of first order differential +C equations to be solved. For the given values of X and the +C vector U(*)=(U(1),U(2),...,U(NEQ)) , the subroutine must +C evaluate the NEQ components of the system of differential +C equations DU/DX=DF(X,U) and store the derivatives in the +C array UPRIME(*), that is, UPRIME(I) = * DU(I)/DX * for +C equations I=1,...,NEQ. +C +C Subroutine DF must not alter X or U(*). You must declare +C the name DF in an external statement in your program that +C calls DHSTRT. You must dimension U and UPRIME in DF. +C +C RPAR and IPAR are DOUBLE PRECISION and INTEGER parameter +C arrays which you can use for communication between your +C program and subroutine DF. They are not used or altered by +C DHSTRT. If you do not need RPAR or IPAR, ignore these +C parameters by treating them as dummy arguments. If you do +C choose to use them, dimension them in your program and in +C DF as arrays of appropriate length. +C +C NEQ -- This is the number of (first order) differential equations +C to be integrated. +C +C A -- This is the initial point of integration. +C +C B -- This is a value of the independent variable used to define +C the direction of integration. A reasonable choice is to +C set B to the first point at which a solution is desired. +C You can also use B, if necessary, to restrict the length +C of the first integration step because the algorithm will +C not compute a starting step length which is bigger than +C ABS(B-A), unless B has been chosen too close to A. +C (it is presumed that DHSTRT has been called with B +C different from A on the machine being used. Also see the +C discussion about the parameter SMALL.) +C +C Y(*) -- This is the vector of initial values of the NEQ solution +C components at the initial point A. +C +C YPRIME(*) -- This is the vector of derivatives of the NEQ +C solution components at the initial point A. +C (defined by the differential equations in subroutine DF) +C +C ETOL -- This is the vector of error tolerances corresponding to +C the NEQ solution components. It is assumed that all +C elements are positive. Following the first integration +C step, the tolerances are expected to be used by the +C integrator in an error test which roughly requires that +C ABS(LOCAL ERROR) .LE. ETOL +C for each vector component. +C +C MORDER -- This is the order of the formula which will be used by +C the initial value method for taking the first integration +C step. +C +C SMALL -- This is a small positive machine dependent constant +C which is used for protecting against computations with +C numbers which are too small relative to the precision of +C floating point arithmetic. SMALL should be set to +C (approximately) the smallest positive DOUBLE PRECISION +C number such that (1.+SMALL) .GT. 1. on the machine being +C used. The quantity SMALL**(3/8) is used in computing +C increments of variables for approximating derivatives by +C differences. Also the algorithm will not compute a +C starting step length which is smaller than +C 100*SMALL*ABS(A). +C +C BIG -- This is a large positive machine dependent constant which +C is used for preventing machine overflows. A reasonable +C choice is to set big to (approximately) the square root of +C the largest DOUBLE PRECISION number which can be held in +C the machine. +C +C SPY(*),PV(*),YP(*),SF(*) -- These are DOUBLE PRECISION work +C arrays of length NEQ which provide the routine with needed +C storage space. +C +C RPAR,IPAR -- These are parameter arrays, of DOUBLE PRECISION and +C INTEGER type, respectively, which can be used for +C communication between your program and the DF subroutine. +C They are not used or altered by DHSTRT. +C +C ********************************************************************** +C On Output (after the return from DHSTRT), +C +C H -- is an appropriate starting step size to be attempted by the +C differential equation method. +C +C All parameters in the call list remain unchanged except for +C the working arrays SPY(*),PV(*),YP(*), and SF(*). +C +C ********************************************************************** +C +C***SEE ALSO DDEABM, DDEBDF, DDERKF +C***ROUTINES CALLED DHVNRM +C***REVISION HISTORY (YYMMDD) +C 820301 DATE WRITTEN +C 890531 Changed all specific intrinsics to generic. (WRB) +C 890831 Modified array declarations. (WRB) +C 890911 Removed unnecessary intrinsics. (WRB) +C 891024 Changed references from DVNORM to DHVNRM. (WRB) +C 891214 Prologue converted to Version 4.0 format. (BAB) +C 900328 Added TYPE section. (WRB) +C 910722 Updated AUTHOR section. (ALS) +C***END PROLOGUE DHSTRT +C + INTEGER IPAR, J, K, LK, MORDER, NEQ + DOUBLE PRECISION A, ABSDX, B, BIG, DA, DELF, DELY, + 1 DFDUB, DFDXB, DHVNRM, + 2 DX, DY, ETOL, FBND, H, PV, RELPER, RPAR, SF, SMALL, SPY, + 3 SRYDPB, TOLEXP, TOLMIN, TOLP, TOLSUM, Y, YDPB, YP, YPRIME + DIMENSION Y(*),YPRIME(*),ETOL(*),SPY(*),PV(*),YP(*), + 1 SF(*),RPAR(*),IPAR(*) + EXTERNAL DF +C +C .................................................................. +C +C BEGIN BLOCK PERMITTING ...EXITS TO 160 +C***FIRST EXECUTABLE STATEMENT DHSTRT + DX = B - A + ABSDX = ABS(DX) + RELPER = SMALL**0.375D0 +C +C ............................................................... +C +C COMPUTE AN APPROXIMATE BOUND (DFDXB) ON THE PARTIAL +C DERIVATIVE OF THE EQUATION WITH RESPECT TO THE +C INDEPENDENT VARIABLE. PROTECT AGAINST AN OVERFLOW. +C ALSO COMPUTE A BOUND (FBND) ON THE FIRST DERIVATIVE +C LOCALLY. +C + DA = SIGN(MAX(MIN(RELPER*ABS(A),ABSDX), + 1 100.0D0*SMALL*ABS(A)),DX) + IF (DA .EQ. 0.0D0) DA = RELPER*DX + CALL DF(A+DA,Y,SF,RPAR,IPAR) + DO 10 J = 1, NEQ + YP(J) = SF(J) - YPRIME(J) + 10 CONTINUE + DELF = DHVNRM(YP,NEQ) + DFDXB = BIG + IF (DELF .LT. BIG*ABS(DA)) DFDXB = DELF/ABS(DA) + FBND = DHVNRM(SF,NEQ) +C +C ............................................................... +C +C COMPUTE AN ESTIMATE (DFDUB) OF THE LOCAL LIPSCHITZ +C CONSTANT FOR THE SYSTEM OF DIFFERENTIAL EQUATIONS. THIS +C ALSO REPRESENTS AN ESTIMATE OF THE NORM OF THE JACOBIAN +C LOCALLY. THREE ITERATIONS (TWO WHEN NEQ=1) ARE USED TO +C ESTIMATE THE LIPSCHITZ CONSTANT BY NUMERICAL DIFFERENCES. +C THE FIRST PERTURBATION VECTOR IS BASED ON THE INITIAL +C DERIVATIVES AND DIRECTION OF INTEGRATION. THE SECOND +C PERTURBATION VECTOR IS FORMED USING ANOTHER EVALUATION OF +C THE DIFFERENTIAL EQUATION. THE THIRD PERTURBATION VECTOR +C IS FORMED USING PERTURBATIONS BASED ONLY ON THE INITIAL +C VALUES. COMPONENTS THAT ARE ZERO ARE ALWAYS CHANGED TO +C NON-ZERO VALUES (EXCEPT ON THE FIRST ITERATION). WHEN +C INFORMATION IS AVAILABLE, CARE IS TAKEN TO ENSURE THAT +C COMPONENTS OF THE PERTURBATION VECTOR HAVE SIGNS WHICH ARE +C CONSISTENT WITH THE SLOPES OF LOCAL SOLUTION CURVES. +C ALSO CHOOSE THE LARGEST BOUND (FBND) FOR THE FIRST +C DERIVATIVE. +C +C PERTURBATION VECTOR SIZE IS HELD +C CONSTANT FOR ALL ITERATIONS. COMPUTE +C THIS CHANGE FROM THE +C SIZE OF THE VECTOR OF INITIAL +C VALUES. + DELY = RELPER*DHVNRM(Y,NEQ) + IF (DELY .EQ. 0.0D0) DELY = RELPER + DELY = SIGN(DELY,DX) + DELF = DHVNRM(YPRIME,NEQ) + FBND = MAX(FBND,DELF) + IF (DELF .EQ. 0.0D0) GO TO 30 +C USE INITIAL DERIVATIVES FOR FIRST PERTURBATION + DO 20 J = 1, NEQ + SPY(J) = YPRIME(J) + YP(J) = YPRIME(J) + 20 CONTINUE + GO TO 50 + 30 CONTINUE +C CANNOT HAVE A NULL PERTURBATION VECTOR + DO 40 J = 1, NEQ + SPY(J) = 0.0D0 + YP(J) = 1.0D0 + 40 CONTINUE + DELF = DHVNRM(YP,NEQ) + 50 CONTINUE +C + DFDUB = 0.0D0 + LK = MIN(NEQ+1,3) + DO 140 K = 1, LK +C DEFINE PERTURBED VECTOR OF INITIAL VALUES + DO 60 J = 1, NEQ + PV(J) = Y(J) + DELY*(YP(J)/DELF) + 60 CONTINUE + IF (K .EQ. 2) GO TO 80 +C EVALUATE DERIVATIVES ASSOCIATED WITH PERTURBED +C VECTOR AND COMPUTE CORRESPONDING DIFFERENCES + CALL DF(A,PV,YP,RPAR,IPAR) + DO 70 J = 1, NEQ + PV(J) = YP(J) - YPRIME(J) + 70 CONTINUE + GO TO 100 + 80 CONTINUE +C USE A SHIFTED VALUE OF THE INDEPENDENT VARIABLE +C IN COMPUTING ONE ESTIMATE + CALL DF(A+DA,PV,YP,RPAR,IPAR) + DO 90 J = 1, NEQ + PV(J) = YP(J) - SF(J) + 90 CONTINUE + 100 CONTINUE +C CHOOSE LARGEST BOUNDS ON THE FIRST DERIVATIVE +C AND A LOCAL LIPSCHITZ CONSTANT + FBND = MAX(FBND,DHVNRM(YP,NEQ)) + DELF = DHVNRM(PV,NEQ) +C ...EXIT + IF (DELF .GE. BIG*ABS(DELY)) GO TO 150 + DFDUB = MAX(DFDUB,DELF/ABS(DELY)) +C ......EXIT + IF (K .EQ. LK) GO TO 160 +C CHOOSE NEXT PERTURBATION VECTOR + IF (DELF .EQ. 0.0D0) DELF = 1.0D0 + DO 130 J = 1, NEQ + IF (K .EQ. 2) GO TO 110 + DY = ABS(PV(J)) + IF (DY .EQ. 0.0D0) DY = DELF + GO TO 120 + 110 CONTINUE + DY = Y(J) + IF (DY .EQ. 0.0D0) DY = DELY/RELPER + 120 CONTINUE + IF (SPY(J) .EQ. 0.0D0) SPY(J) = YP(J) + IF (SPY(J) .NE. 0.0D0) DY = SIGN(DY,SPY(J)) + YP(J) = DY + 130 CONTINUE + DELF = DHVNRM(YP,NEQ) + 140 CONTINUE + 150 CONTINUE +C +C PROTECT AGAINST AN OVERFLOW + DFDUB = BIG + 160 CONTINUE +C +C .................................................................. +C +C COMPUTE A BOUND (YDPB) ON THE NORM OF THE SECOND DERIVATIVE +C + YDPB = DFDXB + DFDUB*FBND +C +C .................................................................. +C +C DEFINE THE TOLERANCE PARAMETER UPON WHICH THE STARTING STEP +C SIZE IS TO BE BASED. A VALUE IN THE MIDDLE OF THE ERROR +C TOLERANCE RANGE IS SELECTED. +C + TOLMIN = BIG + TOLSUM = 0.0D0 + DO 170 K = 1, NEQ + TOLEXP = LOG10(ETOL(K)) + TOLMIN = MIN(TOLMIN,TOLEXP) + TOLSUM = TOLSUM + TOLEXP + 170 CONTINUE + TOLP = 10.0D0**(0.5D0*(TOLSUM/NEQ + TOLMIN)/(MORDER+1)) +C +C .................................................................. +C +C COMPUTE A STARTING STEP SIZE BASED ON THE ABOVE FIRST AND +C SECOND DERIVATIVE INFORMATION +C +C RESTRICT THE STEP LENGTH TO BE NOT BIGGER +C THAN ABS(B-A). (UNLESS B IS TOO CLOSE +C TO A) + H = ABSDX +C + IF (YDPB .NE. 0.0D0 .OR. FBND .NE. 0.0D0) GO TO 180 +C +C BOTH FIRST DERIVATIVE TERM (FBND) AND SECOND +C DERIVATIVE TERM (YDPB) ARE ZERO + IF (TOLP .LT. 1.0D0) H = ABSDX*TOLP + GO TO 200 + 180 CONTINUE +C + IF (YDPB .NE. 0.0D0) GO TO 190 +C +C ONLY SECOND DERIVATIVE TERM (YDPB) IS ZERO + IF (TOLP .LT. FBND*ABSDX) H = TOLP/FBND + GO TO 200 + 190 CONTINUE +C +C SECOND DERIVATIVE TERM (YDPB) IS NON-ZERO + SRYDPB = SQRT(0.5D0*YDPB) + IF (TOLP .LT. SRYDPB*ABSDX) H = TOLP/SRYDPB + 200 CONTINUE +C +C FURTHER RESTRICT THE STEP LENGTH TO BE NOT +C BIGGER THAN 1/DFDUB + IF (H*DFDUB .GT. 1.0D0) H = 1.0D0/DFDUB +C +C FINALLY, RESTRICT THE STEP LENGTH TO BE NOT +C SMALLER THAN 100*SMALL*ABS(A). HOWEVER, IF +C A=0. AND THE COMPUTED H UNDERFLOWED TO ZERO, +C THE ALGORITHM RETURNS SMALL*ABS(B) FOR THE +C STEP LENGTH. + H = MAX(H,100.0D0*SMALL*ABS(A)) + IF (H .EQ. 0.0D0) H = SMALL*ABS(B) +C +C NOW SET DIRECTION OF INTEGRATION + H = SIGN(H,DX) +C + RETURN + END diff --git a/external/SLATEC/src/dhvnrm.f b/external/SLATEC/src/dhvnrm.f new file mode 100644 index 0000000..1128d9d --- /dev/null +++ b/external/SLATEC/src/dhvnrm.f @@ -0,0 +1,36 @@ +*DECK DHVNRM + DOUBLE PRECISION FUNCTION DHVNRM (V, NCOMP) +C***BEGIN PROLOGUE DHVNRM +C***SUBSIDIARY +C***PURPOSE Subsidiary to DDEABM, DDEBDF and DDERKF +C***LIBRARY SLATEC +C***TYPE DOUBLE PRECISION (HVNRM-S, DHVNRM-D) +C***AUTHOR Watts, H. A., (SNLA) +C***DESCRIPTION +C +C Compute the maximum norm of the vector V(*) of length NCOMP and +C return the result as DHVNRM +C +C***SEE ALSO DDEABM, DDEBDF, DDERKF +C***ROUTINES CALLED (NONE) +C***REVISION HISTORY (YYMMDD) +C 820301 DATE WRITTEN +C 890531 Changed all specific intrinsics to generic. (WRB) +C 890831 Modified array declarations. (WRB) +C 891024 Changed references from DVNORM to DHVNRM. (WRB) +C 891024 Changed routine name from DVNORM to DHVNRM. (WRB) +C 891214 Prologue converted to Version 4.0 format. (BAB) +C 900328 Added TYPE section. (WRB) +C 910722 Updated AUTHOR section. (ALS) +C***END PROLOGUE DHVNRM +C + INTEGER K, NCOMP + DOUBLE PRECISION V + DIMENSION V(*) +C***FIRST EXECUTABLE STATEMENT DHVNRM + DHVNRM = 0.0D0 + DO 10 K = 1, NCOMP + DHVNRM = MAX(DHVNRM,ABS(V(K))) + 10 CONTINUE + RETURN + END diff --git a/external/SLATEC/src/dintp.f b/external/SLATEC/src/dintp.f new file mode 100644 index 0000000..594f8ea --- /dev/null +++ b/external/SLATEC/src/dintp.f @@ -0,0 +1,141 @@ +*DECK DINTP + SUBROUTINE DINTP (X, Y, XOUT, YOUT, YPOUT, NEQN, KOLD, PHI, IVC, + + IV, KGI, GI, ALPHA, OG, OW, OX, OY) +C***BEGIN PROLOGUE DINTP +C***PURPOSE Approximate the solution at XOUT by evaluating the +C polynomial computed in DSTEPS at XOUT. Must be used in +C conjunction with DSTEPS. +C***LIBRARY SLATEC (DEPAC) +C***CATEGORY I1A1B +C***TYPE DOUBLE PRECISION (SINTRP-S, DINTP-D) +C***KEYWORDS ADAMS METHOD, DEPAC, INITIAL VALUE PROBLEMS, ODE, +C ORDINARY DIFFERENTIAL EQUATIONS, PREDICTOR-CORRECTOR, +C SMOOTH INTERPOLANT +C***AUTHOR Watts, H. A., (SNLA) +C***DESCRIPTION +C +C The methods in subroutine DSTEPS approximate the solution near X +C by a polynomial. Subroutine DINTP approximates the solution at +C XOUT by evaluating the polynomial there. Information defining this +C polynomial is passed from DSTEPS so DINTP cannot be used alone. +C +C Subroutine DSTEPS is completely explained and documented in the text +C "Computer Solution of Ordinary Differential Equations, the Initial +C Value Problem" by L. F. Shampine and M. K. Gordon. +C +C Input to DINTP -- +C +C The user provides storage in the calling program for the arrays in +C the call list +C DIMENSION Y(NEQN),YOUT(NEQN),YPOUT(NEQN),PHI(NEQN,16),OY(NEQN) +C AND ALPHA(12),OG(13),OW(12),GI(11),IV(10) +C and defines +C XOUT -- point at which solution is desired. +C The remaining parameters are defined in DSTEPS and passed to +C DINTP from that subroutine +C +C Output from DINTP -- +C +C YOUT(*) -- solution at XOUT +C YPOUT(*) -- derivative of solution at XOUT +C The remaining parameters are returned unaltered from their input +C values. Integration with DSTEPS may be continued. +C +C***REFERENCES H. A. Watts, A smoother interpolant for DE/STEP, INTRP +C II, Report SAND84-0293, Sandia Laboratories, 1984. +C***ROUTINES CALLED (NONE) +C***REVISION HISTORY (YYMMDD) +C 840201 DATE WRITTEN +C 890831 Modified array declarations. (WRB) +C 890831 REVISION DATE from Version 3.2 +C 891214 Prologue converted to Version 4.0 format. (BAB) +C 920501 Reformatted the REFERENCES section. (WRB) +C***END PROLOGUE DINTP +C + INTEGER I, IQ, IV, IVC, IW, J, JQ, KGI, KOLD, KP1, KP2, + 1 L, M, NEQN + DOUBLE PRECISION ALP, ALPHA, C, G, GDI, GDIF, GI, GAMMA, H, HI, + 1 HMU, OG, OW, OX, OY, PHI, RMU, SIGMA, TEMP1, TEMP2, TEMP3, + 2 W, X, XI, XIM1, XIQ, XOUT, Y, YOUT, YPOUT +C + DIMENSION Y(*),YOUT(*),YPOUT(*),PHI(NEQN,16),OY(*) + DIMENSION G(13),C(13),W(13),OG(13),OW(12),ALPHA(12),GI(11),IV(10) +C +C***FIRST EXECUTABLE STATEMENT DINTP + KP1 = KOLD + 1 + KP2 = KOLD + 2 +C + HI = XOUT - OX + H = X - OX + XI = HI/H + XIM1 = XI - 1.D0 +C +C INITIALIZE W(*) FOR COMPUTING G(*) +C + XIQ = XI + DO 10 IQ = 1,KP1 + XIQ = XI*XIQ + TEMP1 = IQ*(IQ+1) + 10 W(IQ) = XIQ/TEMP1 +C +C COMPUTE THE DOUBLE INTEGRAL TERM GDI +C + IF (KOLD .LE. KGI) GO TO 50 + IF (IVC .GT. 0) GO TO 20 + GDI = 1.0D0/TEMP1 + M = 2 + GO TO 30 + 20 IW = IV(IVC) + GDI = OW(IW) + M = KOLD - IW + 3 + 30 IF (M .GT. KOLD) GO TO 60 + DO 40 I = M,KOLD + 40 GDI = OW(KP2-I) - ALPHA(I)*GDI + GO TO 60 + 50 GDI = GI(KOLD) +C +C COMPUTE G(*) AND C(*) +C + 60 G(1) = XI + G(2) = 0.5D0*XI*XI + C(1) = 1.0D0 + C(2) = XI + IF (KOLD .LT. 2) GO TO 90 + DO 80 I = 2,KOLD + ALP = ALPHA(I) + GAMMA = 1.0D0 + XIM1*ALP + L = KP2 - I + DO 70 JQ = 1,L + 70 W(JQ) = GAMMA*W(JQ) - ALP*W(JQ+1) + G(I+1) = W(1) + 80 C(I+1) = GAMMA*C(I) +C +C DEFINE INTERPOLATION PARAMETERS +C + 90 SIGMA = (W(2) - XIM1*W(1))/GDI + RMU = XIM1*C(KP1)/GDI + HMU = RMU/H +C +C INTERPOLATE FOR THE SOLUTION -- YOUT +C AND FOR THE DERIVATIVE OF THE SOLUTION -- YPOUT +C + DO 100 L = 1,NEQN + YOUT(L) = 0.0D0 + 100 YPOUT(L) = 0.0D0 + DO 120 J = 1,KOLD + I = KP2 - J + GDIF = OG(I) - OG(I-1) + TEMP2 = (G(I) - G(I-1)) - SIGMA*GDIF + TEMP3 = (C(I) - C(I-1)) + RMU*GDIF + DO 110 L = 1,NEQN + YOUT(L) = YOUT(L) + TEMP2*PHI(L,I) + 110 YPOUT(L) = YPOUT(L) + TEMP3*PHI(L,I) + 120 CONTINUE + DO 130 L = 1,NEQN + YOUT(L) = ((1.0D0 - SIGMA)*OY(L) + SIGMA*Y(L)) + + 1 H*(YOUT(L) + (G(1) - SIGMA*OG(1))*PHI(L,1)) + 130 YPOUT(L) = HMU*(OY(L) - Y(L)) + + 1 (YPOUT(L) + (C(1) + RMU*OG(1))*PHI(L,1)) +C + RETURN + END diff --git a/external/SLATEC/src/dintrv.f b/external/SLATEC/src/dintrv.f new file mode 100644 index 0000000..960b591 --- /dev/null +++ b/external/SLATEC/src/dintrv.f @@ -0,0 +1,118 @@ +*DECK DINTRV + SUBROUTINE DINTRV (XT, LXT, X, ILO, ILEFT, MFLAG) +C***BEGIN PROLOGUE DINTRV +C***PURPOSE Compute the largest integer ILEFT in 1 .LE. ILEFT .LE. LXT +C such that XT(ILEFT) .LE. X where XT(*) is a subdivision of +C the X interval. +C***LIBRARY SLATEC +C***CATEGORY E3, K6 +C***TYPE DOUBLE PRECISION (INTRV-S, DINTRV-D) +C***KEYWORDS B-SPLINE, DATA FITTING, INTERPOLATION, SPLINES +C***AUTHOR Amos, D. E., (SNLA) +C***DESCRIPTION +C +C Written by Carl de Boor and modified by D. E. Amos +C +C Abstract **** a double precision routine **** +C DINTRV is the INTERV routine of the reference. +C +C DINTRV computes the largest integer ILEFT in 1 .LE. ILEFT .LE. +C LXT such that XT(ILEFT) .LE. X where XT(*) is a subdivision of +C the X interval. Precisely, +C +C X .LT. XT(1) 1 -1 +C if XT(I) .LE. X .LT. XT(I+1) then ILEFT=I , MFLAG=0 +C XT(LXT) .LE. X LXT 1, +C +C That is, when multiplicities are present in the break point +C to the left of X, the largest index is taken for ILEFT. +C +C Description of Arguments +C +C Input XT,X are double precision +C XT - XT is a knot or break point vector of length LXT +C LXT - length of the XT vector +C X - argument +C ILO - an initialization parameter which must be set +C to 1 the first time the spline array XT is +C processed by DINTRV. +C +C Output +C ILO - ILO contains information for efficient process- +C ing after the initial call and ILO must not be +C changed by the user. Distinct splines require +C distinct ILO parameters. +C ILEFT - largest integer satisfying XT(ILEFT) .LE. X +C MFLAG - signals when X lies out of bounds +C +C Error Conditions +C None +C +C***REFERENCES Carl de Boor, Package for calculating with B-splines, +C SIAM Journal on Numerical Analysis 14, 3 (June 1977), +C pp. 441-472. +C***ROUTINES CALLED (NONE) +C***REVISION HISTORY (YYMMDD) +C 800901 DATE WRITTEN +C 890831 Modified array declarations. (WRB) +C 890831 REVISION DATE from Version 3.2 +C 891214 Prologue converted to Version 4.0 format. (BAB) +C 920501 Reformatted the REFERENCES section. (WRB) +C***END PROLOGUE DINTRV +C + INTEGER IHI, ILEFT, ILO, ISTEP, LXT, MFLAG, MIDDLE + DOUBLE PRECISION X, XT + DIMENSION XT(*) +C***FIRST EXECUTABLE STATEMENT DINTRV + IHI = ILO + 1 + IF (IHI.LT.LXT) GO TO 10 + IF (X.GE.XT(LXT)) GO TO 110 + IF (LXT.LE.1) GO TO 90 + ILO = LXT - 1 + IHI = LXT +C + 10 IF (X.GE.XT(IHI)) GO TO 40 + IF (X.GE.XT(ILO)) GO TO 100 +C +C *** NOW X .LT. XT(IHI) . FIND LOWER BOUND + ISTEP = 1 + 20 IHI = ILO + ILO = IHI - ISTEP + IF (ILO.LE.1) GO TO 30 + IF (X.GE.XT(ILO)) GO TO 70 + ISTEP = ISTEP*2 + GO TO 20 + 30 ILO = 1 + IF (X.LT.XT(1)) GO TO 90 + GO TO 70 +C *** NOW X .GE. XT(ILO) . FIND UPPER BOUND + 40 ISTEP = 1 + 50 ILO = IHI + IHI = ILO + ISTEP + IF (IHI.GE.LXT) GO TO 60 + IF (X.LT.XT(IHI)) GO TO 70 + ISTEP = ISTEP*2 + GO TO 50 + 60 IF (X.GE.XT(LXT)) GO TO 110 + IHI = LXT +C +C *** NOW XT(ILO) .LE. X .LT. XT(IHI) . NARROW THE INTERVAL + 70 MIDDLE = (ILO+IHI)/2 + IF (MIDDLE.EQ.ILO) GO TO 100 +C NOTE. IT IS ASSUMED THAT MIDDLE = ILO IN CASE IHI = ILO+1 + IF (X.LT.XT(MIDDLE)) GO TO 80 + ILO = MIDDLE + GO TO 70 + 80 IHI = MIDDLE + GO TO 70 +C *** SET OUTPUT AND RETURN + 90 MFLAG = -1 + ILEFT = 1 + RETURN + 100 MFLAG = 0 + ILEFT = ILO + RETURN + 110 MFLAG = 1 + ILEFT = LXT + RETURN + END diff --git a/external/SLATEC/src/dsteps.f b/external/SLATEC/src/dsteps.f new file mode 100644 index 0000000..fb61a13 --- /dev/null +++ b/external/SLATEC/src/dsteps.f @@ -0,0 +1,577 @@ +*DECK DSTEPS + SUBROUTINE DSTEPS (DF, NEQN, Y, X, H, EPS, WT, START, HOLD, K, + + KOLD, CRASH, PHI, P, YP, PSI, ALPHA, BETA, SIG, V, W, G, + + PHASE1, NS, NORND, KSTEPS, TWOU, FOURU, XOLD, KPREV, IVC, IV, + + KGI, GI, RPAR, IPAR) +C***BEGIN PROLOGUE DSTEPS +C***PURPOSE Integrate a system of first order ordinary differential +C equations one step. +C***LIBRARY SLATEC (DEPAC) +C***CATEGORY I1A1B +C***TYPE DOUBLE PRECISION (STEPS-S, DSTEPS-D) +C***KEYWORDS ADAMS METHOD, DEPAC, INITIAL VALUE PROBLEMS, ODE, +C ORDINARY DIFFERENTIAL EQUATIONS, PREDICTOR-CORRECTOR +C***AUTHOR Shampine, L. F., (SNLA) +C Gordon, M. K., (SNLA) +C MODIFIED BY H.A. WATTS +C***DESCRIPTION +C +C Written by L. F. Shampine and M. K. Gordon +C +C Abstract +C +C Subroutine DSTEPS is normally used indirectly through subroutine +C DDEABM . Because DDEABM suffices for most problems and is much +C easier to use, using it should be considered before using DSTEPS +C alone. +C +C Subroutine DSTEPS integrates a system of NEQN first order ordinary +C differential equations one step, normally from X to X+H, using a +C modified divided difference form of the Adams Pece formulas. Local +C extrapolation is used to improve absolute stability and accuracy. +C The code adjusts its order and step size to control the local error +C per unit step in a generalized sense. Special devices are included +C to control roundoff error and to detect when the user is requesting +C too much accuracy. +C +C This code is completely explained and documented in the text, +C Computer Solution of Ordinary Differential Equations, The Initial +C Value Problem by L. F. Shampine and M. K. Gordon. +C Further details on use of this code are available in "Solving +C Ordinary Differential Equations with ODE, STEP, and INTRP", +C by L. F. Shampine and M. K. Gordon, SLA-73-1060. +C +C +C The parameters represent -- +C DF -- subroutine to evaluate derivatives +C NEQN -- number of equations to be integrated +C Y(*) -- solution vector at X +C X -- independent variable +C H -- appropriate step size for next step. Normally determined by +C code +C EPS -- local error tolerance +C WT(*) -- vector of weights for error criterion +C START -- logical variable set .TRUE. for first step, .FALSE. +C otherwise +C HOLD -- step size used for last successful step +C K -- appropriate order for next step (determined by code) +C KOLD -- order used for last successful step +C CRASH -- logical variable set .TRUE. when no step can be taken, +C .FALSE. otherwise. +C YP(*) -- derivative of solution vector at X after successful +C step +C KSTEPS -- counter on attempted steps +C TWOU -- 2.*U where U is machine unit roundoff quantity +C FOURU -- 4.*U where U is machine unit roundoff quantity +C RPAR,IPAR -- parameter arrays which you may choose to use +C for communication between your program and subroutine F. +C They are not altered or used by DSTEPS. +C The variables X,XOLD,KOLD,KGI and IVC and the arrays Y,PHI,ALPHA,G, +C W,P,IV and GI are required for the interpolation subroutine SINTRP. +C The remaining variables and arrays are included in the call list +C only to eliminate local retention of variables between calls. +C +C Input to DSTEPS +C +C First call -- +C +C The user must provide storage in his calling program for all arrays +C in the call list, namely +C +C DIMENSION Y(NEQN),WT(NEQN),PHI(NEQN,16),P(NEQN),YP(NEQN),PSI(12), +C 1 ALPHA(12),BETA(12),SIG(13),V(12),W(12),G(13),GI(11),IV(10), +C 2 RPAR(*),IPAR(*) +C +C **Note** +C +C The user must also declare START , CRASH , PHASE1 and NORND +C logical variables and DF an EXTERNAL subroutine, supply the +C subroutine DF(X,Y,YP) to evaluate +C DY(I)/DX = YP(I) = DF(X,Y(1),Y(2),...,Y(NEQN)) +C and initialize only the following parameters. +C NEQN -- number of equations to be integrated +C Y(*) -- vector of initial values of dependent variables +C X -- initial value of the independent variable +C H -- nominal step size indicating direction of integration +C and maximum size of step. Must be variable +C EPS -- local error tolerance per step. Must be variable +C WT(*) -- vector of non-zero weights for error criterion +C START -- .TRUE. +C YP(*) -- vector of initial derivative values +C KSTEPS -- set KSTEPS to zero +C TWOU -- 2.*U where U is machine unit roundoff quantity +C FOURU -- 4.*U where U is machine unit roundoff quantity +C Define U to be the machine unit roundoff quantity by calling +C the function routine D1MACH, U = D1MACH(4), or by +C computing U so that U is the smallest positive number such +C that 1.0+U .GT. 1.0. +C +C DSTEPS requires that the L2 norm of the vector with components +C LOCAL ERROR(L)/WT(L) be less than EPS for a successful step. The +C array WT allows the user to specify an error test appropriate +C for his problem. For example, +C WT(L) = 1.0 specifies absolute error, +C = ABS(Y(L)) error relative to the most recent value of the +C L-th component of the solution, +C = ABS(YP(L)) error relative to the most recent value of +C the L-th component of the derivative, +C = MAX(WT(L),ABS(Y(L))) error relative to the largest +C magnitude of L-th component obtained so far, +C = ABS(Y(L))*RELERR/EPS + ABSERR/EPS specifies a mixed +C relative-absolute test where RELERR is relative +C error, ABSERR is absolute error and EPS = +C MAX(RELERR,ABSERR) . +C +C Subsequent calls -- +C +C Subroutine DSTEPS is designed so that all information needed to +C continue the integration, including the step size H and the order +C K , is returned with each step. With the exception of the step +C size, the error tolerance, and the weights, none of the parameters +C should be altered. The array WT must be updated after each step +C to maintain relative error tests like those above. Normally the +C integration is continued just beyond the desired endpoint and the +C solution interpolated there with subroutine SINTRP . If it is +C impossible to integrate beyond the endpoint, the step size may be +C reduced to hit the endpoint since the code will not take a step +C larger than the H input. Changing the direction of integration, +C i.e., the sign of H , requires the user set START = .TRUE. before +C calling DSTEPS again. This is the only situation in which START +C should be altered. +C +C Output from DSTEPS +C +C Successful Step -- +C +C The subroutine returns after each successful step with START and +C CRASH set .FALSE. . X represents the independent variable +C advanced one step of length HOLD from its value on input and Y +C the solution vector at the new value of X . All other parameters +C represent information corresponding to the new X needed to +C continue the integration. +C +C Unsuccessful Step -- +C +C When the error tolerance is too small for the machine precision, +C the subroutine returns without taking a step and CRASH = .TRUE. . +C An appropriate step size and error tolerance for continuing are +C estimated and all other information is restored as upon input +C before returning. To continue with the larger tolerance, the user +C just calls the code again. A restart is neither required nor +C desirable. +C +C***REFERENCES L. F. Shampine and M. K. Gordon, Solving ordinary +C differential equations with ODE, STEP, and INTRP, +C Report SLA-73-1060, Sandia Laboratories, 1973. +C***ROUTINES CALLED D1MACH, DHSTRT +C***REVISION HISTORY (YYMMDD) +C 740101 DATE WRITTEN +C 890531 Changed all specific intrinsics to generic. (WRB) +C 890831 Modified array declarations. (WRB) +C 890831 REVISION DATE from Version 3.2 +C 891214 Prologue converted to Version 4.0 format. (BAB) +C 920501 Reformatted the REFERENCES section. (WRB) +C***END PROLOGUE DSTEPS +C + INTEGER I, IFAIL, IM1, IP1, IPAR, IQ, J, K, KM1, KM2, KNEW, + 1 KOLD, KP1, KP2, KSTEPS, L, LIMIT1, LIMIT2, NEQN, NS, NSM2, + 2 NSP1, NSP2 + DOUBLE PRECISION ABSH, ALPHA, BETA, BIG, D1MACH, + 1 EPS, ERK, ERKM1, ERKM2, ERKP1, ERR, + 2 FOURU, G, GI, GSTR, H, HNEW, HOLD, P, P5EPS, PHI, PSI, R, + 3 REALI, REALNS, RHO, ROUND, RPAR, SIG, TAU, TEMP1, + 4 TEMP2, TEMP3, TEMP4, TEMP5, TEMP6, TWO, TWOU, U, V, W, WT, + 5 X, XOLD, Y, YP + LOGICAL START,CRASH,PHASE1,NORND + DIMENSION Y(*),WT(*),PHI(NEQN,16),P(*),YP(*),PSI(12), + 1 ALPHA(12),BETA(12),SIG(13),V(12),W(12),G(13),GI(11),IV(10), + 2 RPAR(*),IPAR(*) + DIMENSION TWO(13),GSTR(13) + EXTERNAL DF + SAVE TWO, GSTR +C + DATA TWO(1),TWO(2),TWO(3),TWO(4),TWO(5),TWO(6),TWO(7),TWO(8), + 1 TWO(9),TWO(10),TWO(11),TWO(12),TWO(13) + 2 /2.0D0,4.0D0,8.0D0,16.0D0,32.0D0,64.0D0,128.0D0,256.0D0, + 3 512.0D0,1024.0D0,2048.0D0,4096.0D0,8192.0D0/ + DATA GSTR(1),GSTR(2),GSTR(3),GSTR(4),GSTR(5),GSTR(6),GSTR(7), + 1 GSTR(8),GSTR(9),GSTR(10),GSTR(11),GSTR(12),GSTR(13) + 2 /0.5D0,0.0833D0,0.0417D0,0.0264D0,0.0188D0,0.0143D0,0.0114D0, + 3 0.00936D0,0.00789D0,0.00679D0,0.00592D0,0.00524D0,0.00468D0/ +C +C *** BEGIN BLOCK 0 *** +C CHECK IF STEP SIZE OR ERROR TOLERANCE IS TOO SMALL FOR MACHINE +C PRECISION. IF FIRST STEP, INITIALIZE PHI ARRAY AND ESTIMATE A +C STARTING STEP SIZE. +C *** +C +C IF STEP SIZE IS TOO SMALL, DETERMINE AN ACCEPTABLE ONE +C +C***FIRST EXECUTABLE STATEMENT DSTEPS + CRASH = .TRUE. + IF(ABS(H) .GE. FOURU*ABS(X)) GO TO 5 + H = SIGN(FOURU*ABS(X),H) + RETURN + 5 P5EPS = 0.5D0*EPS +C +C IF ERROR TOLERANCE IS TOO SMALL, INCREASE IT TO AN ACCEPTABLE VALUE +C + ROUND = 0.0D0 + DO 10 L = 1,NEQN + 10 ROUND = ROUND + (Y(L)/WT(L))**2 + ROUND = TWOU*SQRT(ROUND) + IF(P5EPS .GE. ROUND) GO TO 15 + EPS = 2.0D0*ROUND*(1.0D0 + FOURU) + RETURN + 15 CRASH = .FALSE. + G(1) = 1.0D0 + G(2) = 0.5D0 + SIG(1) = 1.0D0 + IF(.NOT.START) GO TO 99 +C +C INITIALIZE. COMPUTE APPROPRIATE STEP SIZE FOR FIRST STEP +C +C CALL DF(X,Y,YP,RPAR,IPAR) +C SUM = 0.0 + DO 20 L = 1,NEQN + PHI(L,1) = YP(L) + 20 PHI(L,2) = 0.0D0 +C20 SUM = SUM + (YP(L)/WT(L))**2 +C SUM = SQRT(SUM) +C ABSH = ABS(H) +C IF(EPS .LT. 16.0*SUM*H*H) ABSH = 0.25*SQRT(EPS/SUM) +C H = SIGN(MAX(ABSH,FOURU*ABS(X)),H) +C + U = D1MACH(4) + BIG = SQRT(D1MACH(2)) + CALL DHSTRT(DF,NEQN,X,X+H,Y,YP,WT,1,U,BIG, + 1 PHI(1,3),PHI(1,4),PHI(1,5),PHI(1,6),RPAR,IPAR,H) +C + HOLD = 0.0D0 + K = 1 + KOLD = 0 + KPREV = 0 + START = .FALSE. + PHASE1 = .TRUE. + NORND = .TRUE. + IF(P5EPS .GT. 100.0D0*ROUND) GO TO 99 + NORND = .FALSE. + DO 25 L = 1,NEQN + 25 PHI(L,15) = 0.0D0 + 99 IFAIL = 0 +C *** END BLOCK 0 *** +C +C *** BEGIN BLOCK 1 *** +C COMPUTE COEFFICIENTS OF FORMULAS FOR THIS STEP. AVOID COMPUTING +C THOSE QUANTITIES NOT CHANGED WHEN STEP SIZE IS NOT CHANGED. +C *** +C + 100 KP1 = K+1 + KP2 = K+2 + KM1 = K-1 + KM2 = K-2 +C +C NS IS THE NUMBER OF DSTEPS TAKEN WITH SIZE H, INCLUDING THE CURRENT +C ONE. WHEN K.LT.NS, NO COEFFICIENTS CHANGE +C + IF(H .NE. HOLD) NS = 0 + IF (NS.LE.KOLD) NS = NS+1 + NSP1 = NS+1 + IF (K .LT. NS) GO TO 199 +C +C COMPUTE THOSE COMPONENTS OF ALPHA(*),BETA(*),PSI(*),SIG(*) WHICH +C ARE CHANGED +C + BETA(NS) = 1.0D0 + REALNS = NS + ALPHA(NS) = 1.0D0/REALNS + TEMP1 = H*REALNS + SIG(NSP1) = 1.0D0 + IF(K .LT. NSP1) GO TO 110 + DO 105 I = NSP1,K + IM1 = I-1 + TEMP2 = PSI(IM1) + PSI(IM1) = TEMP1 + BETA(I) = BETA(IM1)*PSI(IM1)/TEMP2 + TEMP1 = TEMP2 + H + ALPHA(I) = H/TEMP1 + REALI = I + 105 SIG(I+1) = REALI*ALPHA(I)*SIG(I) + 110 PSI(K) = TEMP1 +C +C COMPUTE COEFFICIENTS G(*) +C +C INITIALIZE V(*) AND SET W(*). +C + IF(NS .GT. 1) GO TO 120 + DO 115 IQ = 1,K + TEMP3 = IQ*(IQ+1) + V(IQ) = 1.0D0/TEMP3 + 115 W(IQ) = V(IQ) + IVC = 0 + KGI = 0 + IF (K .EQ. 1) GO TO 140 + KGI = 1 + GI(1) = W(2) + GO TO 140 +C +C IF ORDER WAS RAISED, UPDATE DIAGONAL PART OF V(*) +C + 120 IF(K .LE. KPREV) GO TO 130 + IF (IVC .EQ. 0) GO TO 122 + JV = KP1 - IV(IVC) + IVC = IVC - 1 + GO TO 123 + 122 JV = 1 + TEMP4 = K*KP1 + V(K) = 1.0D0/TEMP4 + W(K) = V(K) + IF (K .NE. 2) GO TO 123 + KGI = 1 + GI(1) = W(2) + 123 NSM2 = NS-2 + IF(NSM2 .LT. JV) GO TO 130 + DO 125 J = JV,NSM2 + I = K-J + V(I) = V(I) - ALPHA(J+1)*V(I+1) + 125 W(I) = V(I) + IF (I .NE. 2) GO TO 130 + KGI = NS - 1 + GI(KGI) = W(2) +C +C UPDATE V(*) AND SET W(*) +C + 130 LIMIT1 = KP1 - NS + TEMP5 = ALPHA(NS) + DO 135 IQ = 1,LIMIT1 + V(IQ) = V(IQ) - TEMP5*V(IQ+1) + 135 W(IQ) = V(IQ) + G(NSP1) = W(1) + IF (LIMIT1 .EQ. 1) GO TO 137 + KGI = NS + GI(KGI) = W(2) + 137 W(LIMIT1+1) = V(LIMIT1+1) + IF (K .GE. KOLD) GO TO 140 + IVC = IVC + 1 + IV(IVC) = LIMIT1 + 2 +C +C COMPUTE THE G(*) IN THE WORK VECTOR W(*) +C + 140 NSP2 = NS + 2 + KPREV = K + IF(KP1 .LT. NSP2) GO TO 199 + DO 150 I = NSP2,KP1 + LIMIT2 = KP2 - I + TEMP6 = ALPHA(I-1) + DO 145 IQ = 1,LIMIT2 + 145 W(IQ) = W(IQ) - TEMP6*W(IQ+1) + 150 G(I) = W(1) + 199 CONTINUE +C *** END BLOCK 1 *** +C +C *** BEGIN BLOCK 2 *** +C PREDICT A SOLUTION P(*), EVALUATE DERIVATIVES USING PREDICTED +C SOLUTION, ESTIMATE LOCAL ERROR AT ORDER K AND ERRORS AT ORDERS K, +C K-1, K-2 AS IF CONSTANT STEP SIZE WERE USED. +C *** +C +C INCREMENT COUNTER ON ATTEMPTED DSTEPS +C + KSTEPS = KSTEPS + 1 +C +C CHANGE PHI TO PHI STAR +C + IF(K .LT. NSP1) GO TO 215 + DO 210 I = NSP1,K + TEMP1 = BETA(I) + DO 205 L = 1,NEQN + 205 PHI(L,I) = TEMP1*PHI(L,I) + 210 CONTINUE +C +C PREDICT SOLUTION AND DIFFERENCES +C + 215 DO 220 L = 1,NEQN + PHI(L,KP2) = PHI(L,KP1) + PHI(L,KP1) = 0.0D0 + 220 P(L) = 0.0D0 + DO 230 J = 1,K + I = KP1 - J + IP1 = I+1 + TEMP2 = G(I) + DO 225 L = 1,NEQN + P(L) = P(L) + TEMP2*PHI(L,I) + 225 PHI(L,I) = PHI(L,I) + PHI(L,IP1) + 230 CONTINUE + IF(NORND) GO TO 240 + DO 235 L = 1,NEQN + TAU = H*P(L) - PHI(L,15) + P(L) = Y(L) + TAU + 235 PHI(L,16) = (P(L) - Y(L)) - TAU + GO TO 250 + 240 DO 245 L = 1,NEQN + 245 P(L) = Y(L) + H*P(L) + 250 XOLD = X + X = X + H + ABSH = ABS(H) + CALL DF(X,P,YP,RPAR,IPAR) +C +C ESTIMATE ERRORS AT ORDERS K,K-1,K-2 +C + ERKM2 = 0.0D0 + ERKM1 = 0.0D0 + ERK = 0.0D0 + DO 265 L = 1,NEQN + TEMP3 = 1.0D0/WT(L) + TEMP4 = YP(L) - PHI(L,1) + IF(KM2)265,260,255 + 255 ERKM2 = ERKM2 + ((PHI(L,KM1)+TEMP4)*TEMP3)**2 + 260 ERKM1 = ERKM1 + ((PHI(L,K)+TEMP4)*TEMP3)**2 + 265 ERK = ERK + (TEMP4*TEMP3)**2 + IF(KM2)280,275,270 + 270 ERKM2 = ABSH*SIG(KM1)*GSTR(KM2)*SQRT(ERKM2) + 275 ERKM1 = ABSH*SIG(K)*GSTR(KM1)*SQRT(ERKM1) + 280 TEMP5 = ABSH*SQRT(ERK) + ERR = TEMP5*(G(K)-G(KP1)) + ERK = TEMP5*SIG(KP1)*GSTR(K) + KNEW = K +C +C TEST IF ORDER SHOULD BE LOWERED +C + IF(KM2)299,290,285 + 285 IF(MAX(ERKM1,ERKM2) .LE. ERK) KNEW = KM1 + GO TO 299 + 290 IF(ERKM1 .LE. 0.5D0*ERK) KNEW = KM1 +C +C TEST IF STEP SUCCESSFUL +C + 299 IF(ERR .LE. EPS) GO TO 400 +C *** END BLOCK 2 *** +C +C *** BEGIN BLOCK 3 *** +C THE STEP IS UNSUCCESSFUL. RESTORE X, PHI(*,*), PSI(*) . +C IF THIRD CONSECUTIVE FAILURE, SET ORDER TO ONE. IF STEP FAILS MORE +C THAN THREE TIMES, CONSIDER AN OPTIMAL STEP SIZE. DOUBLE ERROR +C TOLERANCE AND RETURN IF ESTIMATED STEP SIZE IS TOO SMALL FOR MACHINE +C PRECISION. +C *** +C +C RESTORE X, PHI(*,*) AND PSI(*) +C + PHASE1 = .FALSE. + X = XOLD + DO 310 I = 1,K + TEMP1 = 1.0D0/BETA(I) + IP1 = I+1 + DO 305 L = 1,NEQN + 305 PHI(L,I) = TEMP1*(PHI(L,I) - PHI(L,IP1)) + 310 CONTINUE + IF(K .LT. 2) GO TO 320 + DO 315 I = 2,K + 315 PSI(I-1) = PSI(I) - H +C +C ON THIRD FAILURE, SET ORDER TO ONE. THEREAFTER, USE OPTIMAL STEP +C SIZE +C + 320 IFAIL = IFAIL + 1 + TEMP2 = 0.5D0 + IF(IFAIL - 3) 335,330,325 + 325 IF(P5EPS .LT. 0.25D0*ERK) TEMP2 = SQRT(P5EPS/ERK) + 330 KNEW = 1 + 335 H = TEMP2*H + K = KNEW + NS = 0 + IF(ABS(H) .GE. FOURU*ABS(X)) GO TO 340 + CRASH = .TRUE. + H = SIGN(FOURU*ABS(X),H) + EPS = EPS + EPS + RETURN + 340 GO TO 100 +C *** END BLOCK 3 *** +C +C *** BEGIN BLOCK 4 *** +C THE STEP IS SUCCESSFUL. CORRECT THE PREDICTED SOLUTION, EVALUATE +C THE DERIVATIVES USING THE CORRECTED SOLUTION AND UPDATE THE +C DIFFERENCES. DETERMINE BEST ORDER AND STEP SIZE FOR NEXT STEP. +C *** + 400 KOLD = K + HOLD = H +C +C CORRECT AND EVALUATE +C + TEMP1 = H*G(KP1) + IF(NORND) GO TO 410 + DO 405 L = 1,NEQN + TEMP3 = Y(L) + RHO = TEMP1*(YP(L) - PHI(L,1)) - PHI(L,16) + Y(L) = P(L) + RHO + PHI(L,15) = (Y(L) - P(L)) - RHO + 405 P(L) = TEMP3 + GO TO 420 + 410 DO 415 L = 1,NEQN + TEMP3 = Y(L) + Y(L) = P(L) + TEMP1*(YP(L) - PHI(L,1)) + 415 P(L) = TEMP3 + 420 CALL DF(X,Y,YP,RPAR,IPAR) +C +C UPDATE DIFFERENCES FOR NEXT STEP +C + DO 425 L = 1,NEQN + PHI(L,KP1) = YP(L) - PHI(L,1) + 425 PHI(L,KP2) = PHI(L,KP1) - PHI(L,KP2) + DO 435 I = 1,K + DO 430 L = 1,NEQN + 430 PHI(L,I) = PHI(L,I) + PHI(L,KP1) + 435 CONTINUE +C +C ESTIMATE ERROR AT ORDER K+1 UNLESS: +C IN FIRST PHASE WHEN ALWAYS RAISE ORDER, +C ALREADY DECIDED TO LOWER ORDER, +C STEP SIZE NOT CONSTANT SO ESTIMATE UNRELIABLE +C + ERKP1 = 0.0D0 + IF(KNEW .EQ. KM1 .OR. K .EQ. 12) PHASE1 = .FALSE. + IF(PHASE1) GO TO 450 + IF(KNEW .EQ. KM1) GO TO 455 + IF(KP1 .GT. NS) GO TO 460 + DO 440 L = 1,NEQN + 440 ERKP1 = ERKP1 + (PHI(L,KP2)/WT(L))**2 + ERKP1 = ABSH*GSTR(KP1)*SQRT(ERKP1) +C +C USING ESTIMATED ERROR AT ORDER K+1, DETERMINE APPROPRIATE ORDER +C FOR NEXT STEP +C + IF(K .GT. 1) GO TO 445 + IF(ERKP1 .GE. 0.5D0*ERK) GO TO 460 + GO TO 450 + 445 IF(ERKM1 .LE. MIN(ERK,ERKP1)) GO TO 455 + IF(ERKP1 .GE. ERK .OR. K .EQ. 12) GO TO 460 +C +C HERE ERKP1 .LT. ERK .LT. MAX(ERKM1,ERKM2) ELSE ORDER WOULD HAVE +C BEEN LOWERED IN BLOCK 2. THUS ORDER IS TO BE RAISED +C +C RAISE ORDER +C + 450 K = KP1 + ERK = ERKP1 + GO TO 460 +C +C LOWER ORDER +C + 455 K = KM1 + ERK = ERKM1 +C +C WITH NEW ORDER DETERMINE APPROPRIATE STEP SIZE FOR NEXT STEP +C + 460 HNEW = H + H + IF(PHASE1) GO TO 465 + IF(P5EPS .GE. ERK*TWO(K+1)) GO TO 465 + HNEW = H + IF(P5EPS .GE. ERK) GO TO 465 + TEMP2 = K+1 + R = (P5EPS/ERK)**(1.0D0/TEMP2) + HNEW = ABSH*MAX(0.5D0,MIN(0.9D0,R)) + HNEW = SIGN(MAX(HNEW,FOURU*ABS(X)),H) + 465 H = HNEW + RETURN +C *** END BLOCK 4 *** + END diff --git a/external/SLATEC/src/fdump.f b/external/SLATEC/src/fdump.f new file mode 100644 index 0000000..1f44a57 --- /dev/null +++ b/external/SLATEC/src/fdump.f @@ -0,0 +1,31 @@ +*DECK FDUMP + SUBROUTINE FDUMP +C***BEGIN PROLOGUE FDUMP +C***PURPOSE Symbolic dump (should be locally written). +C***LIBRARY SLATEC (XERROR) +C***CATEGORY R3 +C***TYPE ALL (FDUMP-A) +C***KEYWORDS ERROR, XERMSG +C***AUTHOR Jones, R. E., (SNLA) +C***DESCRIPTION +C +C ***Note*** Machine Dependent Routine +C FDUMP is intended to be replaced by a locally written +C version which produces a symbolic dump. Failing this, +C it should be replaced by a version which prints the +C subprogram nesting list. Note that this dump must be +C printed on each of up to five files, as indicated by the +C XGETUA routine. See XSETUA and XGETUA for details. +C +C Written by Ron Jones, with SLATEC Common Math Library Subcommittee +C +C***REFERENCES (NONE) +C***ROUTINES CALLED (NONE) +C***REVISION HISTORY (YYMMDD) +C 790801 DATE WRITTEN +C 861211 REVISION DATE from Version 3.2 +C 891214 Prologue converted to Version 4.0 format. (BAB) +C***END PROLOGUE FDUMP +C***FIRST EXECUTABLE STATEMENT FDUMP + RETURN + END diff --git a/external/SLATEC/src/i1mach.f b/external/SLATEC/src/i1mach.f new file mode 100644 index 0000000..ad04e7b --- /dev/null +++ b/external/SLATEC/src/i1mach.f @@ -0,0 +1,888 @@ +*DECK I1MACH + INTEGER FUNCTION I1MACH (I) +C***BEGIN PROLOGUE I1MACH +C***PURPOSE Return integer machine dependent constants. +C***LIBRARY SLATEC +C***CATEGORY R1 +C***TYPE INTEGER (I1MACH-I) +C***KEYWORDS MACHINE CONSTANTS +C***AUTHOR Fox, P. A., (Bell Labs) +C Hall, A. D., (Bell Labs) +C Schryer, N. L., (Bell Labs) +C***DESCRIPTION +C +C I1MACH can be used to obtain machine-dependent parameters for the +C local machine environment. It is a function subprogram with one +C (input) argument and can be referenced as follows: +C +C K = I1MACH(I) +C +C where I=1,...,16. The (output) value of K above is determined by +C the (input) value of I. The results for various values of I are +C discussed below. +C +C I/O unit numbers: +C I1MACH( 1) = the standard input unit. +C I1MACH( 2) = the standard output unit. +C I1MACH( 3) = the standard punch unit. +C I1MACH( 4) = the standard error message unit. +C +C Words: +C I1MACH( 5) = the number of bits per integer storage unit. +C I1MACH( 6) = the number of characters per integer storage unit. +C +C Integers: +C assume integers are represented in the S-digit, base-A form +C +C sign ( X(S-1)*A**(S-1) + ... + X(1)*A + X(0) ) +C +C where 0 .LE. X(I) .LT. A for I=0,...,S-1. +C I1MACH( 7) = A, the base. +C I1MACH( 8) = S, the number of base-A digits. +C I1MACH( 9) = A**S - 1, the largest magnitude. +C +C Floating-Point Numbers: +C Assume floating-point numbers are represented in the T-digit, +C base-B form +C sign (B**E)*( (X(1)/B) + ... + (X(T)/B**T) ) +C +C where 0 .LE. X(I) .LT. B for I=1,...,T, +C 0 .LT. X(1), and EMIN .LE. E .LE. EMAX. +C I1MACH(10) = B, the base. +C +C Single-Precision: +C I1MACH(11) = T, the number of base-B digits. +C I1MACH(12) = EMIN, the smallest exponent E. +C I1MACH(13) = EMAX, the largest exponent E. +C +C Double-Precision: +C I1MACH(14) = T, the number of base-B digits. +C I1MACH(15) = EMIN, the smallest exponent E. +C I1MACH(16) = EMAX, the largest exponent E. +C +C To alter this function for a particular environment, the desired +C set of DATA statements should be activated by removing the C from +C column 1. Also, the values of I1MACH(1) - I1MACH(4) should be +C checked for consistency with the local operating system. +C +C***REFERENCES P. A. Fox, A. D. Hall and N. L. Schryer, Framework for +C a portable library, ACM Transactions on Mathematical +C Software 4, 2 (June 1978), pp. 177-188. +C***ROUTINES CALLED (NONE) +C***REVISION HISTORY (YYMMDD) +C 750101 DATE WRITTEN +C 891012 Added VAX G-floating constants. (WRB) +C 891012 REVISION DATE from Version 3.2 +C 891214 Prologue converted to Version 4.0 format. (BAB) +C 900618 Added DEC RISC constants. (WRB) +C 900723 Added IBM RS 6000 constants. (WRB) +C 901009 Correct I1MACH(7) for IBM Mainframes. Should be 2 not 16. +C (RWC) +C 910710 Added HP 730 constants. (SMR) +C 911114 Added Convex IEEE constants. (WRB) +C 920121 Added SUN -r8 compiler option constants. (WRB) +C 920229 Added Touchstone Delta i860 constants. (WRB) +C 920501 Reformatted the REFERENCES section. (WRB) +C 920625 Added Convex -p8 and -pd8 compiler option constants. +C (BKS, WRB) +C 930201 Added DEC Alpha and SGI constants. (RWC and WRB) +C 930618 Corrected I1MACH(5) for Convex -p8 and -pd8 compiler +C options. (DWL, RWC and WRB). +C***END PROLOGUE I1MACH +C + INTEGER IMACH(16),OUTPUT + SAVE IMACH + EQUIVALENCE (IMACH(4),OUTPUT) +C +C MACHINE CONSTANTS FOR THE AMIGA +C ABSOFT COMPILER +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 5 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / 2147483647 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -126 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 53 / +C DATA IMACH(15) / -1022 / +C DATA IMACH(16) / 1023 / +C +C MACHINE CONSTANTS FOR THE APOLLO +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 6 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / 2147483647 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -125 / +C DATA IMACH(13) / 129 / +C DATA IMACH(14) / 53 / +C DATA IMACH(15) / -1021 / +C DATA IMACH(16) / 1025 / +C +C MACHINE CONSTANTS FOR THE BURROUGHS 1700 SYSTEM +C +C DATA IMACH( 1) / 7 / +C DATA IMACH( 2) / 2 / +C DATA IMACH( 3) / 2 / +C DATA IMACH( 4) / 2 / +C DATA IMACH( 5) / 36 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 33 / +C DATA IMACH( 9) / Z1FFFFFFFF / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -256 / +C DATA IMACH(13) / 255 / +C DATA IMACH(14) / 60 / +C DATA IMACH(15) / -256 / +C DATA IMACH(16) / 255 / +C +C MACHINE CONSTANTS FOR THE BURROUGHS 5700 SYSTEM +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 7 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 48 / +C DATA IMACH( 6) / 6 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 39 / +C DATA IMACH( 9) / O0007777777777777 / +C DATA IMACH(10) / 8 / +C DATA IMACH(11) / 13 / +C DATA IMACH(12) / -50 / +C DATA IMACH(13) / 76 / +C DATA IMACH(14) / 26 / +C DATA IMACH(15) / -50 / +C DATA IMACH(16) / 76 / +C +C MACHINE CONSTANTS FOR THE BURROUGHS 6700/7700 SYSTEMS +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 7 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 48 / +C DATA IMACH( 6) / 6 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 39 / +C DATA IMACH( 9) / O0007777777777777 / +C DATA IMACH(10) / 8 / +C DATA IMACH(11) / 13 / +C DATA IMACH(12) / -50 / +C DATA IMACH(13) / 76 / +C DATA IMACH(14) / 26 / +C DATA IMACH(15) / -32754 / +C DATA IMACH(16) / 32780 / +C +C MACHINE CONSTANTS FOR THE CDC 170/180 SERIES USING NOS/VE +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 7 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 64 / +C DATA IMACH( 6) / 8 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 63 / +C DATA IMACH( 9) / 9223372036854775807 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 47 / +C DATA IMACH(12) / -4095 / +C DATA IMACH(13) / 4094 / +C DATA IMACH(14) / 94 / +C DATA IMACH(15) / -4095 / +C DATA IMACH(16) / 4094 / +C +C MACHINE CONSTANTS FOR THE CDC 6000/7000 SERIES +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 7 / +C DATA IMACH( 4) / 6LOUTPUT/ +C DATA IMACH( 5) / 60 / +C DATA IMACH( 6) / 10 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 48 / +C DATA IMACH( 9) / 00007777777777777777B / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 47 / +C DATA IMACH(12) / -929 / +C DATA IMACH(13) / 1070 / +C DATA IMACH(14) / 94 / +C DATA IMACH(15) / -929 / +C DATA IMACH(16) / 1069 / +C +C MACHINE CONSTANTS FOR THE CELERITY C1260 +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 6 / +C DATA IMACH( 4) / 0 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / Z'7FFFFFFF' / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -126 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 53 / +C DATA IMACH(15) / -1022 / +C DATA IMACH(16) / 1023 / +C +C MACHINE CONSTANTS FOR THE CONVEX +C USING THE -fn COMPILER OPTION +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 7 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / 2147483647 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -127 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 53 / +C DATA IMACH(15) / -1023 / +C DATA IMACH(16) / 1023 / +C +C MACHINE CONSTANTS FOR THE CONVEX +C USING THE -fi COMPILER OPTION +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 7 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / 2147483647 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -125 / +C DATA IMACH(13) / 128 / +C DATA IMACH(14) / 53 / +C DATA IMACH(15) / -1021 / +C DATA IMACH(16) / 1024 / +C +C MACHINE CONSTANTS FOR THE CONVEX +C USING THE -p8 COMPILER OPTION +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 7 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 64 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 63 / +C DATA IMACH( 9) / 9223372036854775807 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 53 / +C DATA IMACH(12) / -1023 / +C DATA IMACH(13) / 1023 / +C DATA IMACH(14) / 113 / +C DATA IMACH(15) / -16383 / +C DATA IMACH(16) / 16383 / +C +C MACHINE CONSTANTS FOR THE CONVEX +C USING THE -pd8 COMPILER OPTION +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 7 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 64 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 63 / +C DATA IMACH( 9) / 9223372036854775807 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 53 / +C DATA IMACH(12) / -1023 / +C DATA IMACH(13) / 1023 / +C DATA IMACH(14) / 53 / +C DATA IMACH(15) / -1023 / +C DATA IMACH(16) / 1023 / +C +C MACHINE CONSTANTS FOR THE CRAY +C USING THE 46 BIT INTEGER COMPILER OPTION +C +C DATA IMACH( 1) / 100 / +C DATA IMACH( 2) / 101 / +C DATA IMACH( 3) / 102 / +C DATA IMACH( 4) / 101 / +C DATA IMACH( 5) / 64 / +C DATA IMACH( 6) / 8 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 46 / +C DATA IMACH( 9) / 1777777777777777B / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 47 / +C DATA IMACH(12) / -8189 / +C DATA IMACH(13) / 8190 / +C DATA IMACH(14) / 94 / +C DATA IMACH(15) / -8099 / +C DATA IMACH(16) / 8190 / +C +C MACHINE CONSTANTS FOR THE CRAY +C USING THE 64 BIT INTEGER COMPILER OPTION +C +C DATA IMACH( 1) / 100 / +C DATA IMACH( 2) / 101 / +C DATA IMACH( 3) / 102 / +C DATA IMACH( 4) / 101 / +C DATA IMACH( 5) / 64 / +C DATA IMACH( 6) / 8 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 63 / +C DATA IMACH( 9) / 777777777777777777777B / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 47 / +C DATA IMACH(12) / -8189 / +C DATA IMACH(13) / 8190 / +C DATA IMACH(14) / 94 / +C DATA IMACH(15) / -8099 / +C DATA IMACH(16) / 8190 / +C +C MACHINE CONSTANTS FOR THE DATA GENERAL ECLIPSE S/200 +C +C DATA IMACH( 1) / 11 / +C DATA IMACH( 2) / 12 / +C DATA IMACH( 3) / 8 / +C DATA IMACH( 4) / 10 / +C DATA IMACH( 5) / 16 / +C DATA IMACH( 6) / 2 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 15 / +C DATA IMACH( 9) / 32767 / +C DATA IMACH(10) / 16 / +C DATA IMACH(11) / 6 / +C DATA IMACH(12) / -64 / +C DATA IMACH(13) / 63 / +C DATA IMACH(14) / 14 / +C DATA IMACH(15) / -64 / +C DATA IMACH(16) / 63 / +C +C MACHINE CONSTANTS FOR THE DEC ALPHA +C USING G_FLOAT +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 5 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / 2147483647 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -127 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 53 / +C DATA IMACH(15) / -1023 / +C DATA IMACH(16) / 1023 / +C +C MACHINE CONSTANTS FOR THE DEC ALPHA +C USING IEEE_FLOAT +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 6 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / 2147483647 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -125 / +C DATA IMACH(13) / 128 / +C DATA IMACH(14) / 53 / +C DATA IMACH(15) / -1021 / +C DATA IMACH(16) / 1024 / +C +C MACHINE CONSTANTS FOR THE DEC RISC +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 6 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / 2147483647 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -125 / +C DATA IMACH(13) / 128 / +C DATA IMACH(14) / 53 / +C DATA IMACH(15) / -1021 / +C DATA IMACH(16) / 1024 / +C +C MACHINE CONSTANTS FOR THE DEC VAX +C USING D_FLOATING +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 5 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / 2147483647 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -127 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 56 / +C DATA IMACH(15) / -127 / +C DATA IMACH(16) / 127 / +C +C MACHINE CONSTANTS FOR THE DEC VAX +C USING G_FLOATING +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 5 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / 2147483647 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -127 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 53 / +C DATA IMACH(15) / -1023 / +C DATA IMACH(16) / 1023 / +C +C MACHINE CONSTANTS FOR THE ELXSI 6400 +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 6 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 32 / +C DATA IMACH( 9) / 2147483647 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -126 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 53 / +C DATA IMACH(15) / -1022 / +C DATA IMACH(16) / 1023 / +C +C MACHINE CONSTANTS FOR THE HARRIS 220 +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 0 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 24 / +C DATA IMACH( 6) / 3 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 23 / +C DATA IMACH( 9) / 8388607 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 23 / +C DATA IMACH(12) / -127 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 38 / +C DATA IMACH(15) / -127 / +C DATA IMACH(16) / 127 / +C +C MACHINE CONSTANTS FOR THE HONEYWELL 600/6000 SERIES +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 43 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 36 / +C DATA IMACH( 6) / 6 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 35 / +C DATA IMACH( 9) / O377777777777 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 27 / +C DATA IMACH(12) / -127 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 63 / +C DATA IMACH(15) / -127 / +C DATA IMACH(16) / 127 / +C +C MACHINE CONSTANTS FOR THE HP 730 +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 6 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / 2147483647 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -125 / +C DATA IMACH(13) / 128 / +C DATA IMACH(14) / 53 / +C DATA IMACH(15) / -1021 / +C DATA IMACH(16) / 1024 / +C +C MACHINE CONSTANTS FOR THE HP 2100 +C 3 WORD DOUBLE PRECISION OPTION WITH FTN4 +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 4 / +C DATA IMACH( 4) / 1 / +C DATA IMACH( 5) / 16 / +C DATA IMACH( 6) / 2 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 15 / +C DATA IMACH( 9) / 32767 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 23 / +C DATA IMACH(12) / -128 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 39 / +C DATA IMACH(15) / -128 / +C DATA IMACH(16) / 127 / +C +C MACHINE CONSTANTS FOR THE HP 2100 +C 4 WORD DOUBLE PRECISION OPTION WITH FTN4 +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 4 / +C DATA IMACH( 4) / 1 / +C DATA IMACH( 5) / 16 / +C DATA IMACH( 6) / 2 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 15 / +C DATA IMACH( 9) / 32767 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 23 / +C DATA IMACH(12) / -128 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 55 / +C DATA IMACH(15) / -128 / +C DATA IMACH(16) / 127 / +C +C MACHINE CONSTANTS FOR THE HP 9000 +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 6 / +C DATA IMACH( 4) / 7 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 32 / +C DATA IMACH( 9) / 2147483647 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -126 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 53 / +C DATA IMACH(15) / -1015 / +C DATA IMACH(16) / 1017 / +C +C MACHINE CONSTANTS FOR THE IBM 360/370 SERIES, +C THE XEROX SIGMA 5/7/9, THE SEL SYSTEMS 85/86, AND +C THE PERKIN ELMER (INTERDATA) 7/32. +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 7 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / Z7FFFFFFF / +C DATA IMACH(10) / 16 / +C DATA IMACH(11) / 6 / +C DATA IMACH(12) / -64 / +C DATA IMACH(13) / 63 / +C DATA IMACH(14) / 14 / +C DATA IMACH(15) / -64 / +C DATA IMACH(16) / 63 / +C +C MACHINE CONSTANTS FOR THE IBM PC +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 0 / +C DATA IMACH( 4) / 0 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / 2147483647 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -125 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 53 / +C DATA IMACH(15) / -1021 / +C DATA IMACH(16) / 1023 / +C +C MACHINE CONSTANTS FOR THE IBM RS 6000 +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 6 / +C DATA IMACH( 4) / 0 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / 2147483647 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -125 / +C DATA IMACH(13) / 128 / +C DATA IMACH(14) / 53 / +C DATA IMACH(15) / -1021 / +C DATA IMACH(16) / 1024 / +C +C MACHINE CONSTANTS FOR THE INTEL i860 +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 6 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / 2147483647 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -125 / +C DATA IMACH(13) / 128 / +C DATA IMACH(14) / 53 / +C DATA IMACH(15) / -1021 / +C DATA IMACH(16) / 1024 / +C +C MACHINE CONSTANTS FOR THE PDP-10 (KA PROCESSOR) +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 5 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 36 / +C DATA IMACH( 6) / 5 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 35 / +C DATA IMACH( 9) / "377777777777 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 27 / +C DATA IMACH(12) / -128 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 54 / +C DATA IMACH(15) / -101 / +C DATA IMACH(16) / 127 / +C +C MACHINE CONSTANTS FOR THE PDP-10 (KI PROCESSOR) +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 5 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 36 / +C DATA IMACH( 6) / 5 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 35 / +C DATA IMACH( 9) / "377777777777 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 27 / +C DATA IMACH(12) / -128 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 62 / +C DATA IMACH(15) / -128 / +C DATA IMACH(16) / 127 / +C +C MACHINE CONSTANTS FOR PDP-11 FORTRAN SUPPORTING +C 32-BIT INTEGER ARITHMETIC. +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 5 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / 2147483647 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -127 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 56 / +C DATA IMACH(15) / -127 / +C DATA IMACH(16) / 127 / +C +C MACHINE CONSTANTS FOR PDP-11 FORTRAN SUPPORTING +C 16-BIT INTEGER ARITHMETIC. +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 5 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 16 / +C DATA IMACH( 6) / 2 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 15 / +C DATA IMACH( 9) / 32767 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -127 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 56 / +C DATA IMACH(15) / -127 / +C DATA IMACH(16) / 127 / +C +C MACHINE CONSTANTS FOR THE SILICON GRAPHICS +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 6 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / 2147483647 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -125 / +C DATA IMACH(13) / 128 / +C DATA IMACH(14) / 53 / +C DATA IMACH(15) / -1021 / +C DATA IMACH(16) / 1024 / +C +C MACHINE CONSTANTS FOR THE SUN +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 6 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / 2147483647 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -125 / +C DATA IMACH(13) / 128 / +C DATA IMACH(14) / 53 / +C DATA IMACH(15) / -1021 / +C DATA IMACH(16) / 1024 / +C +C MACHINE CONSTANTS FOR THE SUN +C USING THE -r8 COMPILER OPTION +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 6 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / 2147483647 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 53 / +C DATA IMACH(12) / -1021 / +C DATA IMACH(13) / 1024 / +C DATA IMACH(14) / 113 / +C DATA IMACH(15) / -16381 / +C DATA IMACH(16) / 16384 / +C +C MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES FTN COMPILER +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 1 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 36 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 35 / +C DATA IMACH( 9) / O377777777777 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 27 / +C DATA IMACH(12) / -128 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 60 / +C DATA IMACH(15) / -1024 / +C DATA IMACH(16) / 1023 / +C +C MACHINE CONSTANTS FOR THE Z80 MICROPROCESSOR +C +C DATA IMACH( 1) / 1 / +C DATA IMACH( 2) / 1 / +C DATA IMACH( 3) / 0 / +C DATA IMACH( 4) / 1 / +C DATA IMACH( 5) / 16 / +C DATA IMACH( 6) / 2 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 15 / +C DATA IMACH( 9) / 32767 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -127 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 56 / +C DATA IMACH(15) / -127 / +C DATA IMACH(16) / 127 / +C +C***FIRST EXECUTABLE STATEMENT I1MACH + IF (I .LT. 1 .OR. I .GT. 16) GO TO 10 +C + I1MACH = IMACH(I) + RETURN +C + 10 CONTINUE + WRITE (UNIT = OUTPUT, FMT = 9000) + 9000 FORMAT ('1ERROR 1 IN I1MACH - I OUT OF BOUNDS') +C +C CALL FDUMP +C + STOP + END diff --git a/external/SLATEC/src/j4save.f b/external/SLATEC/src/j4save.f new file mode 100644 index 0000000..6ec799b --- /dev/null +++ b/external/SLATEC/src/j4save.f @@ -0,0 +1,65 @@ +*DECK J4SAVE + FUNCTION J4SAVE (IWHICH, IVALUE, ISET) +C***BEGIN PROLOGUE J4SAVE +C***SUBSIDIARY +C***PURPOSE Save or recall global variables needed by error +C handling routines. +C***LIBRARY SLATEC (XERROR) +C***TYPE INTEGER (J4SAVE-I) +C***KEYWORDS ERROR MESSAGES, ERROR NUMBER, RECALL, SAVE, XERROR +C***AUTHOR Jones, R. E., (SNLA) +C***DESCRIPTION +C +C Abstract +C J4SAVE saves and recalls several global variables needed +C by the library error handling routines. +C +C Description of Parameters +C --Input-- +C IWHICH - Index of item desired. +C = 1 Refers to current error number. +C = 2 Refers to current error control flag. +C = 3 Refers to current unit number to which error +C messages are to be sent. (0 means use standard.) +C = 4 Refers to the maximum number of times any +C message is to be printed (as set by XERMAX). +C = 5 Refers to the total number of units to which +C each error message is to be written. +C = 6 Refers to the 2nd unit for error messages +C = 7 Refers to the 3rd unit for error messages +C = 8 Refers to the 4th unit for error messages +C = 9 Refers to the 5th unit for error messages +C IVALUE - The value to be set for the IWHICH-th parameter, +C if ISET is .TRUE. . +C ISET - If ISET=.TRUE., the IWHICH-th parameter will BE +C given the value, IVALUE. If ISET=.FALSE., the +C IWHICH-th parameter will be unchanged, and IVALUE +C is a dummy parameter. +C --Output-- +C The (old) value of the IWHICH-th parameter will be returned +C in the function value, J4SAVE. +C +C***SEE ALSO XERMSG +C***REFERENCES R. E. Jones and D. K. Kahaner, XERROR, the SLATEC +C Error-handling Package, SAND82-0800, Sandia +C Laboratories, 1982. +C***ROUTINES CALLED (NONE) +C***REVISION HISTORY (YYMMDD) +C 790801 DATE WRITTEN +C 891214 Prologue converted to Version 4.0 format. (BAB) +C 900205 Minor modifications to prologue. (WRB) +C 900402 Added TYPE section. (WRB) +C 910411 Added KEYWORDS section. (WRB) +C 920501 Reformatted the REFERENCES section. (WRB) +C***END PROLOGUE J4SAVE + LOGICAL ISET + INTEGER IPARAM(9) + SAVE IPARAM + DATA IPARAM(1),IPARAM(2),IPARAM(3),IPARAM(4)/0,2,0,10/ + DATA IPARAM(5)/1/ + DATA IPARAM(6),IPARAM(7),IPARAM(8),IPARAM(9)/0,0,0,0/ +C***FIRST EXECUTABLE STATEMENT J4SAVE + J4SAVE = IPARAM(IWHICH) + IF (ISET) IPARAM(IWHICH) = IVALUE + RETURN + END diff --git a/external/SLATEC/src/xercnt.f b/external/SLATEC/src/xercnt.f new file mode 100644 index 0000000..06c82ab --- /dev/null +++ b/external/SLATEC/src/xercnt.f @@ -0,0 +1,60 @@ +*DECK XERCNT + SUBROUTINE XERCNT (LIBRAR, SUBROU, MESSG, NERR, LEVEL, KONTRL) +C***BEGIN PROLOGUE XERCNT +C***SUBSIDIARY +C***PURPOSE Allow user control over handling of errors. +C***LIBRARY SLATEC (XERROR) +C***CATEGORY R3C +C***TYPE ALL (XERCNT-A) +C***KEYWORDS ERROR, XERROR +C***AUTHOR Jones, R. E., (SNLA) +C***DESCRIPTION +C +C Abstract +C Allows user control over handling of individual errors. +C Just after each message is recorded, but before it is +C processed any further (i.e., before it is printed or +C a decision to abort is made), a call is made to XERCNT. +C If the user has provided his own version of XERCNT, he +C can then override the value of KONTROL used in processing +C this message by redefining its value. +C KONTRL may be set to any value from -2 to 2. +C The meanings for KONTRL are the same as in XSETF, except +C that the value of KONTRL changes only for this message. +C If KONTRL is set to a value outside the range from -2 to 2, +C it will be moved back into that range. +C +C Description of Parameters +C +C --Input-- +C LIBRAR - the library that the routine is in. +C SUBROU - the subroutine that XERMSG is being called from +C MESSG - the first 20 characters of the error message. +C NERR - same as in the call to XERMSG. +C LEVEL - same as in the call to XERMSG. +C KONTRL - the current value of the control flag as set +C by a call to XSETF. +C +C --Output-- +C KONTRL - the new value of KONTRL. If KONTRL is not +C defined, it will remain at its original value. +C This changed value of control affects only +C the current occurrence of the current message. +C +C***REFERENCES R. E. Jones and D. K. Kahaner, XERROR, the SLATEC +C Error-handling Package, SAND82-0800, Sandia +C Laboratories, 1982. +C***ROUTINES CALLED (NONE) +C***REVISION HISTORY (YYMMDD) +C 790801 DATE WRITTEN +C 861211 REVISION DATE from Version 3.2 +C 891214 Prologue converted to Version 4.0 format. (BAB) +C 900206 Routine changed from user-callable to subsidiary. (WRB) +C 900510 Changed calling sequence to include LIBRARY and SUBROUTINE +C names, changed routine name from XERCTL to XERCNT. (RWC) +C 920501 Reformatted the REFERENCES section. (WRB) +C***END PROLOGUE XERCNT + CHARACTER*(*) LIBRAR, SUBROU, MESSG +C***FIRST EXECUTABLE STATEMENT XERCNT + RETURN + END diff --git a/external/SLATEC/src/xerhlt.f b/external/SLATEC/src/xerhlt.f new file mode 100644 index 0000000..89b2a77 --- /dev/null +++ b/external/SLATEC/src/xerhlt.f @@ -0,0 +1,39 @@ +*DECK XERHLT + SUBROUTINE XERHLT (MESSG) +C***BEGIN PROLOGUE XERHLT +C***SUBSIDIARY +C***PURPOSE Abort program execution and print error message. +C***LIBRARY SLATEC (XERROR) +C***CATEGORY R3C +C***TYPE ALL (XERHLT-A) +C***KEYWORDS ABORT PROGRAM EXECUTION, ERROR, XERROR +C***AUTHOR Jones, R. E., (SNLA) +C***DESCRIPTION +C +C Abstract +C ***Note*** machine dependent routine +C XERHLT aborts the execution of the program. +C The error message causing the abort is given in the calling +C sequence, in case one needs it for printing on a dayfile, +C for example. +C +C Description of Parameters +C MESSG is as in XERMSG. +C +C***REFERENCES R. E. Jones and D. K. Kahaner, XERROR, the SLATEC +C Error-handling Package, SAND82-0800, Sandia +C Laboratories, 1982. +C***ROUTINES CALLED (NONE) +C***REVISION HISTORY (YYMMDD) +C 790801 DATE WRITTEN +C 861211 REVISION DATE from Version 3.2 +C 891214 Prologue converted to Version 4.0 format. (BAB) +C 900206 Routine changed from user-callable to subsidiary. (WRB) +C 900510 Changed calling sequence to delete length of character +C and changed routine name from XERABT to XERHLT. (RWC) +C 920501 Reformatted the REFERENCES section. (WRB) +C***END PROLOGUE XERHLT + CHARACTER*(*) MESSG +C***FIRST EXECUTABLE STATEMENT XERHLT + STOP + END diff --git a/external/SLATEC/src/xermsg.f b/external/SLATEC/src/xermsg.f new file mode 100644 index 0000000..46c83ec --- /dev/null +++ b/external/SLATEC/src/xermsg.f @@ -0,0 +1,364 @@ +*DECK XERMSG + SUBROUTINE XERMSG (LIBRAR, SUBROU, MESSG, NERR, LEVEL) +C***BEGIN PROLOGUE XERMSG +C***PURPOSE Process error messages for SLATEC and other libraries. +C***LIBRARY SLATEC (XERROR) +C***CATEGORY R3C +C***TYPE ALL (XERMSG-A) +C***KEYWORDS ERROR MESSAGE, XERROR +C***AUTHOR Fong, Kirby, (NMFECC at LLNL) +C***DESCRIPTION +C +C XERMSG processes a diagnostic message in a manner determined by the +C value of LEVEL and the current value of the library error control +C flag, KONTRL. See subroutine XSETF for details. +C +C LIBRAR A character constant (or character variable) with the name +C of the library. This will be 'SLATEC' for the SLATEC +C Common Math Library. The error handling package is +C general enough to be used by many libraries +C simultaneously, so it is desirable for the routine that +C detects and reports an error to identify the library name +C as well as the routine name. +C +C SUBROU A character constant (or character variable) with the name +C of the routine that detected the error. Usually it is the +C name of the routine that is calling XERMSG. There are +C some instances where a user callable library routine calls +C lower level subsidiary routines where the error is +C detected. In such cases it may be more informative to +C supply the name of the routine the user called rather than +C the name of the subsidiary routine that detected the +C error. +C +C MESSG A character constant (or character variable) with the text +C of the error or warning message. In the example below, +C the message is a character constant that contains a +C generic message. +C +C CALL XERMSG ('SLATEC', 'MMPY', +C *'THE ORDER OF THE MATRIX EXCEEDS THE ROW DIMENSION', +C *3, 1) +C +C It is possible (and is sometimes desirable) to generate a +C specific message--e.g., one that contains actual numeric +C values. Specific numeric values can be converted into +C character strings using formatted WRITE statements into +C character variables. This is called standard Fortran +C internal file I/O and is exemplified in the first three +C lines of the following example. You can also catenate +C substrings of characters to construct the error message. +C Here is an example showing the use of both writing to +C an internal file and catenating character strings. +C +C CHARACTER*5 CHARN, CHARL +C WRITE (CHARN,10) N +C WRITE (CHARL,10) LDA +C 10 FORMAT(I5) +C CALL XERMSG ('SLATEC', 'MMPY', 'THE ORDER'//CHARN// +C * ' OF THE MATRIX EXCEEDS ITS ROW DIMENSION OF'// +C * CHARL, 3, 1) +C +C There are two subtleties worth mentioning. One is that +C the // for character catenation is used to construct the +C error message so that no single character constant is +C continued to the next line. This avoids confusion as to +C whether there are trailing blanks at the end of the line. +C The second is that by catenating the parts of the message +C as an actual argument rather than encoding the entire +C message into one large character variable, we avoid +C having to know how long the message will be in order to +C declare an adequate length for that large character +C variable. XERMSG calls XERPRN to print the message using +C multiple lines if necessary. If the message is very long, +C XERPRN will break it into pieces of 72 characters (as +C requested by XERMSG) for printing on multiple lines. +C Also, XERMSG asks XERPRN to prefix each line with ' * ' +C so that the total line length could be 76 characters. +C Note also that XERPRN scans the error message backwards +C to ignore trailing blanks. Another feature is that +C the substring '$$' is treated as a new line sentinel +C by XERPRN. If you want to construct a multiline +C message without having to count out multiples of 72 +C characters, just use '$$' as a separator. '$$' +C obviously must occur within 72 characters of the +C start of each line to have its intended effect since +C XERPRN is asked to wrap around at 72 characters in +C addition to looking for '$$'. +C +C NERR An integer value that is chosen by the library routine's +C author. It must be in the range -99 to 999 (three +C printable digits). Each distinct error should have its +C own error number. These error numbers should be described +C in the machine readable documentation for the routine. +C The error numbers need be unique only within each routine, +C so it is reasonable for each routine to start enumerating +C errors from 1 and proceeding to the next integer. +C +C LEVEL An integer value in the range 0 to 2 that indicates the +C level (severity) of the error. Their meanings are +C +C -1 A warning message. This is used if it is not clear +C that there really is an error, but the user's attention +C may be needed. An attempt is made to only print this +C message once. +C +C 0 A warning message. This is used if it is not clear +C that there really is an error, but the user's attention +C may be needed. +C +C 1 A recoverable error. This is used even if the error is +C so serious that the routine cannot return any useful +C answer. If the user has told the error package to +C return after recoverable errors, then XERMSG will +C return to the Library routine which can then return to +C the user's routine. The user may also permit the error +C package to terminate the program upon encountering a +C recoverable error. +C +C 2 A fatal error. XERMSG will not return to its caller +C after it receives a fatal error. This level should +C hardly ever be used; it is much better to allow the +C user a chance to recover. An example of one of the few +C cases in which it is permissible to declare a level 2 +C error is a reverse communication Library routine that +C is likely to be called repeatedly until it integrates +C across some interval. If there is a serious error in +C the input such that another step cannot be taken and +C the Library routine is called again without the input +C error having been corrected by the caller, the Library +C routine will probably be called forever with improper +C input. In this case, it is reasonable to declare the +C error to be fatal. +C +C Each of the arguments to XERMSG is input; none will be modified by +C XERMSG. A routine may make multiple calls to XERMSG with warning +C level messages; however, after a call to XERMSG with a recoverable +C error, the routine should return to the user. Do not try to call +C XERMSG with a second recoverable error after the first recoverable +C error because the error package saves the error number. The user +C can retrieve this error number by calling another entry point in +C the error handling package and then clear the error number when +C recovering from the error. Calling XERMSG in succession causes the +C old error number to be overwritten by the latest error number. +C This is considered harmless for error numbers associated with +C warning messages but must not be done for error numbers of serious +C errors. After a call to XERMSG with a recoverable error, the user +C must be given a chance to call NUMXER or XERCLR to retrieve or +C clear the error number. +C***REFERENCES R. E. Jones and D. K. Kahaner, XERROR, the SLATEC +C Error-handling Package, SAND82-0800, Sandia +C Laboratories, 1982. +C***ROUTINES CALLED FDUMP, J4SAVE, XERCNT, XERHLT, XERPRN, XERSVE +C***REVISION HISTORY (YYMMDD) +C 880101 DATE WRITTEN +C 880621 REVISED AS DIRECTED AT SLATEC CML MEETING OF FEBRUARY 1988. +C THERE ARE TWO BASIC CHANGES. +C 1. A NEW ROUTINE, XERPRN, IS USED INSTEAD OF XERPRT TO +C PRINT MESSAGES. THIS ROUTINE WILL BREAK LONG MESSAGES +C INTO PIECES FOR PRINTING ON MULTIPLE LINES. '$$' IS +C ACCEPTED AS A NEW LINE SENTINEL. A PREFIX CAN BE +C ADDED TO EACH LINE TO BE PRINTED. XERMSG USES EITHER +C ' ***' OR ' * ' AND LONG MESSAGES ARE BROKEN EVERY +C 72 CHARACTERS (AT MOST) SO THAT THE MAXIMUM LINE +C LENGTH OUTPUT CAN NOW BE AS GREAT AS 76. +C 2. THE TEXT OF ALL MESSAGES IS NOW IN UPPER CASE SINCE THE +C FORTRAN STANDARD DOCUMENT DOES NOT ADMIT THE EXISTENCE +C OF LOWER CASE. +C 880708 REVISED AFTER THE SLATEC CML MEETING OF JUNE 29 AND 30. +C THE PRINCIPAL CHANGES ARE +C 1. CLARIFY COMMENTS IN THE PROLOGUES +C 2. RENAME XRPRNT TO XERPRN +C 3. REWORK HANDLING OF '$$' IN XERPRN TO HANDLE BLANK LINES +C SIMILAR TO THE WAY FORMAT STATEMENTS HANDLE THE / +C CHARACTER FOR NEW RECORDS. +C 890706 REVISED WITH THE HELP OF FRED FRITSCH AND REG CLEMENS TO +C CLEAN UP THE CODING. +C 890721 REVISED TO USE NEW FEATURE IN XERPRN TO COUNT CHARACTERS IN +C PREFIX. +C 891013 REVISED TO CORRECT COMMENTS. +C 891214 Prologue converted to Version 4.0 format. (WRB) +C 900510 Changed test on NERR to be -9999999 < NERR < 99999999, but +C NERR .ne. 0, and on LEVEL to be -2 < LEVEL < 3. Added +C LEVEL=-1 logic, changed calls to XERSAV to XERSVE, and +C XERCTL to XERCNT. (RWC) +C 920501 Reformatted the REFERENCES section. (WRB) +C***END PROLOGUE XERMSG + CHARACTER*(*) LIBRAR, SUBROU, MESSG + CHARACTER*8 XLIBR, XSUBR + CHARACTER*72 TEMP + CHARACTER*20 LFIRST +C***FIRST EXECUTABLE STATEMENT XERMSG + LKNTRL = J4SAVE (2, 0, .FALSE.) + MAXMES = J4SAVE (4, 0, .FALSE.) +C +C LKNTRL IS A LOCAL COPY OF THE CONTROL FLAG KONTRL. +C MAXMES IS THE MAXIMUM NUMBER OF TIMES ANY PARTICULAR MESSAGE +C SHOULD BE PRINTED. +C +C WE PRINT A FATAL ERROR MESSAGE AND TERMINATE FOR AN ERROR IN +C CALLING XERMSG. THE ERROR NUMBER SHOULD BE POSITIVE, +C AND THE LEVEL SHOULD BE BETWEEN 0 AND 2. +C + IF (NERR.LT.-9999999 .OR. NERR.GT.99999999 .OR. NERR.EQ.0 .OR. + * LEVEL.LT.-1 .OR. LEVEL.GT.2) THEN + CALL XERPRN (' ***', -1, 'FATAL ERROR IN...$$ ' // + * 'XERMSG -- INVALID ERROR NUMBER OR LEVEL$$ '// + * 'JOB ABORT DUE TO FATAL ERROR.', 72) + CALL XERSVE (' ', ' ', ' ', 0, 0, 0, KDUMMY) + CALL XERHLT (' ***XERMSG -- INVALID INPUT') + RETURN + ENDIF +C +C RECORD THE MESSAGE. +C + I = J4SAVE (1, NERR, .TRUE.) + CALL XERSVE (LIBRAR, SUBROU, MESSG, 1, NERR, LEVEL, KOUNT) +C +C HANDLE PRINT-ONCE WARNING MESSAGES. +C + IF (LEVEL.EQ.-1 .AND. KOUNT.GT.1) RETURN +C +C ALLOW TEMPORARY USER OVERRIDE OF THE CONTROL FLAG. +C + XLIBR = LIBRAR + XSUBR = SUBROU + LFIRST = MESSG + LERR = NERR + LLEVEL = LEVEL + CALL XERCNT (XLIBR, XSUBR, LFIRST, LERR, LLEVEL, LKNTRL) +C + LKNTRL = MAX(-2, MIN(2,LKNTRL)) + MKNTRL = ABS(LKNTRL) +C +C SKIP PRINTING IF THE CONTROL FLAG VALUE AS RESET IN XERCNT IS +C ZERO AND THE ERROR IS NOT FATAL. +C + IF (LEVEL.LT.2 .AND. LKNTRL.EQ.0) GO TO 30 + IF (LEVEL.EQ.0 .AND. KOUNT.GT.MAXMES) GO TO 30 + IF (LEVEL.EQ.1 .AND. KOUNT.GT.MAXMES .AND. MKNTRL.EQ.1) GO TO 30 + IF (LEVEL.EQ.2 .AND. KOUNT.GT.MAX(1,MAXMES)) GO TO 30 +C +C ANNOUNCE THE NAMES OF THE LIBRARY AND SUBROUTINE BY BUILDING A +C MESSAGE IN CHARACTER VARIABLE TEMP (NOT EXCEEDING 66 CHARACTERS) +C AND SENDING IT OUT VIA XERPRN. PRINT ONLY IF CONTROL FLAG +C IS NOT ZERO. +C + IF (LKNTRL .NE. 0) THEN + TEMP(1:21) = 'MESSAGE FROM ROUTINE ' + I = MIN(LEN(SUBROU), 16) + TEMP(22:21+I) = SUBROU(1:I) + TEMP(22+I:33+I) = ' IN LIBRARY ' + LTEMP = 33 + I + I = MIN(LEN(LIBRAR), 16) + TEMP(LTEMP+1:LTEMP+I) = LIBRAR (1:I) + TEMP(LTEMP+I+1:LTEMP+I+1) = '.' + LTEMP = LTEMP + I + 1 + CALL XERPRN (' ***', -1, TEMP(1:LTEMP), 72) + ENDIF +C +C IF LKNTRL IS POSITIVE, PRINT AN INTRODUCTORY LINE BEFORE +C PRINTING THE MESSAGE. THE INTRODUCTORY LINE TELLS THE CHOICE +C FROM EACH OF THE FOLLOWING THREE OPTIONS. +C 1. LEVEL OF THE MESSAGE +C 'INFORMATIVE MESSAGE' +C 'POTENTIALLY RECOVERABLE ERROR' +C 'FATAL ERROR' +C 2. WHETHER CONTROL FLAG WILL ALLOW PROGRAM TO CONTINUE +C 'PROG CONTINUES' +C 'PROG ABORTED' +C 3. WHETHER OR NOT A TRACEBACK WAS REQUESTED. (THE TRACEBACK +C MAY NOT BE IMPLEMENTED AT SOME SITES, SO THIS ONLY TELLS +C WHAT WAS REQUESTED, NOT WHAT WAS DELIVERED.) +C 'TRACEBACK REQUESTED' +C 'TRACEBACK NOT REQUESTED' +C NOTICE THAT THE LINE INCLUDING FOUR PREFIX CHARACTERS WILL NOT +C EXCEED 74 CHARACTERS. +C WE SKIP THE NEXT BLOCK IF THE INTRODUCTORY LINE IS NOT NEEDED. +C + IF (LKNTRL .GT. 0) THEN +C +C THE FIRST PART OF THE MESSAGE TELLS ABOUT THE LEVEL. +C + IF (LEVEL .LE. 0) THEN + TEMP(1:20) = 'INFORMATIVE MESSAGE,' + LTEMP = 20 + ELSEIF (LEVEL .EQ. 1) THEN + TEMP(1:30) = 'POTENTIALLY RECOVERABLE ERROR,' + LTEMP = 30 + ELSE + TEMP(1:12) = 'FATAL ERROR,' + LTEMP = 12 + ENDIF +C +C THEN WHETHER THE PROGRAM WILL CONTINUE. +C + IF ((MKNTRL.EQ.2 .AND. LEVEL.GE.1) .OR. + * (MKNTRL.EQ.1 .AND. LEVEL.EQ.2)) THEN + TEMP(LTEMP+1:LTEMP+14) = ' PROG ABORTED,' + LTEMP = LTEMP + 14 + ELSE + TEMP(LTEMP+1:LTEMP+16) = ' PROG CONTINUES,' + LTEMP = LTEMP + 16 + ENDIF +C +C FINALLY TELL WHETHER THERE SHOULD BE A TRACEBACK. +C + IF (LKNTRL .GT. 0) THEN + TEMP(LTEMP+1:LTEMP+20) = ' TRACEBACK REQUESTED' + LTEMP = LTEMP + 20 + ELSE + TEMP(LTEMP+1:LTEMP+24) = ' TRACEBACK NOT REQUESTED' + LTEMP = LTEMP + 24 + ENDIF + CALL XERPRN (' ***', -1, TEMP(1:LTEMP), 72) + ENDIF +C +C NOW SEND OUT THE MESSAGE. +C + CALL XERPRN (' * ', -1, MESSG, 72) +C +C IF LKNTRL IS POSITIVE, WRITE THE ERROR NUMBER AND REQUEST A +C TRACEBACK. +C + IF (LKNTRL .GT. 0) THEN + WRITE (TEMP, '(''ERROR NUMBER = '', I8)') NERR + DO 10 I=16,22 + IF (TEMP(I:I) .NE. ' ') GO TO 20 + 10 CONTINUE +C + 20 CALL XERPRN (' * ', -1, TEMP(1:15) // TEMP(I:23), 72) + CALL FDUMP + ENDIF +C +C IF LKNTRL IS NOT ZERO, PRINT A BLANK LINE AND AN END OF MESSAGE. +C + IF (LKNTRL .NE. 0) THEN + CALL XERPRN (' * ', -1, ' ', 72) + CALL XERPRN (' ***', -1, 'END OF MESSAGE', 72) + CALL XERPRN (' ', 0, ' ', 72) + ENDIF +C +C IF THE ERROR IS NOT FATAL OR THE ERROR IS RECOVERABLE AND THE +C CONTROL FLAG IS SET FOR RECOVERY, THEN RETURN. +C + 30 IF (LEVEL.LE.0 .OR. (LEVEL.EQ.1 .AND. MKNTRL.LE.1)) RETURN +C +C THE PROGRAM WILL BE STOPPED DUE TO AN UNRECOVERED ERROR OR A +C FATAL ERROR. PRINT THE REASON FOR THE ABORT AND THE ERROR +C SUMMARY IF THE CONTROL FLAG AND THE MAXIMUM ERROR COUNT PERMIT. +C + IF (LKNTRL.GT.0 .AND. KOUNT.LT.MAX(1,MAXMES)) THEN + IF (LEVEL .EQ. 1) THEN + CALL XERPRN + * (' ***', -1, 'JOB ABORT DUE TO UNRECOVERED ERROR.', 72) + ELSE + CALL XERPRN(' ***', -1, 'JOB ABORT DUE TO FATAL ERROR.', 72) + ENDIF + CALL XERSVE (' ', ' ', ' ', -1, 0, 0, KDUMMY) + CALL XERHLT (' ') + ELSE + CALL XERHLT (MESSG) + ENDIF + RETURN + END diff --git a/external/SLATEC/src/xerprn.f b/external/SLATEC/src/xerprn.f new file mode 100644 index 0000000..97eedf4 --- /dev/null +++ b/external/SLATEC/src/xerprn.f @@ -0,0 +1,228 @@ +*DECK XERPRN + SUBROUTINE XERPRN (PREFIX, NPREF, MESSG, NWRAP) +C***BEGIN PROLOGUE XERPRN +C***SUBSIDIARY +C***PURPOSE Print error messages processed by XERMSG. +C***LIBRARY SLATEC (XERROR) +C***CATEGORY R3C +C***TYPE ALL (XERPRN-A) +C***KEYWORDS ERROR MESSAGES, PRINTING, XERROR +C***AUTHOR Fong, Kirby, (NMFECC at LLNL) +C***DESCRIPTION +C +C This routine sends one or more lines to each of the (up to five) +C logical units to which error messages are to be sent. This routine +C is called several times by XERMSG, sometimes with a single line to +C print and sometimes with a (potentially very long) message that may +C wrap around into multiple lines. +C +C PREFIX Input argument of type CHARACTER. This argument contains +C characters to be put at the beginning of each line before +C the body of the message. No more than 16 characters of +C PREFIX will be used. +C +C NPREF Input argument of type INTEGER. This argument is the number +C of characters to use from PREFIX. If it is negative, the +C intrinsic function LEN is used to determine its length. If +C it is zero, PREFIX is not used. If it exceeds 16 or if +C LEN(PREFIX) exceeds 16, only the first 16 characters will be +C used. If NPREF is positive and the length of PREFIX is less +C than NPREF, a copy of PREFIX extended with blanks to length +C NPREF will be used. +C +C MESSG Input argument of type CHARACTER. This is the text of a +C message to be printed. If it is a long message, it will be +C broken into pieces for printing on multiple lines. Each line +C will start with the appropriate prefix and be followed by a +C piece of the message. NWRAP is the number of characters per +C piece; that is, after each NWRAP characters, we break and +C start a new line. In addition the characters '$$' embedded +C in MESSG are a sentinel for a new line. The counting of +C characters up to NWRAP starts over for each new line. The +C value of NWRAP typically used by XERMSG is 72 since many +C older error messages in the SLATEC Library are laid out to +C rely on wrap-around every 72 characters. +C +C NWRAP Input argument of type INTEGER. This gives the maximum size +C piece into which to break MESSG for printing on multiple +C lines. An embedded '$$' ends a line, and the count restarts +C at the following character. If a line break does not occur +C on a blank (it would split a word) that word is moved to the +C next line. Values of NWRAP less than 16 will be treated as +C 16. Values of NWRAP greater than 132 will be treated as 132. +C The actual line length will be NPREF + NWRAP after NPREF has +C been adjusted to fall between 0 and 16 and NWRAP has been +C adjusted to fall between 16 and 132. +C +C***REFERENCES R. E. Jones and D. K. Kahaner, XERROR, the SLATEC +C Error-handling Package, SAND82-0800, Sandia +C Laboratories, 1982. +C***ROUTINES CALLED I1MACH, XGETUA +C***REVISION HISTORY (YYMMDD) +C 880621 DATE WRITTEN +C 880708 REVISED AFTER THE SLATEC CML SUBCOMMITTEE MEETING OF +C JUNE 29 AND 30 TO CHANGE THE NAME TO XERPRN AND TO REWORK +C THE HANDLING OF THE NEW LINE SENTINEL TO BEHAVE LIKE THE +C SLASH CHARACTER IN FORMAT STATEMENTS. +C 890706 REVISED WITH THE HELP OF FRED FRITSCH AND REG CLEMENS TO +C STREAMLINE THE CODING AND FIX A BUG THAT CAUSED EXTRA BLANK +C LINES TO BE PRINTED. +C 890721 REVISED TO ADD A NEW FEATURE. A NEGATIVE VALUE OF NPREF +C CAUSES LEN(PREFIX) TO BE USED AS THE LENGTH. +C 891013 REVISED TO CORRECT ERROR IN CALCULATING PREFIX LENGTH. +C 891214 Prologue converted to Version 4.0 format. (WRB) +C 900510 Added code to break messages between words. (RWC) +C 920501 Reformatted the REFERENCES section. (WRB) +C***END PROLOGUE XERPRN + CHARACTER*(*) PREFIX, MESSG + INTEGER NPREF, NWRAP + CHARACTER*148 CBUFF + INTEGER IU(5), NUNIT + CHARACTER*2 NEWLIN + PARAMETER (NEWLIN = '$$') +C***FIRST EXECUTABLE STATEMENT XERPRN + CALL XGETUA(IU,NUNIT) +C +C A ZERO VALUE FOR A LOGICAL UNIT NUMBER MEANS TO USE THE STANDARD +C ERROR MESSAGE UNIT INSTEAD. I1MACH(4) RETRIEVES THE STANDARD +C ERROR MESSAGE UNIT. +C + N = I1MACH(4) + DO 10 I=1,NUNIT + IF (IU(I) .EQ. 0) IU(I) = N + 10 CONTINUE +C +C LPREF IS THE LENGTH OF THE PREFIX. THE PREFIX IS PLACED AT THE +C BEGINNING OF CBUFF, THE CHARACTER BUFFER, AND KEPT THERE DURING +C THE REST OF THIS ROUTINE. +C + IF ( NPREF .LT. 0 ) THEN + LPREF = LEN(PREFIX) + ELSE + LPREF = NPREF + ENDIF + LPREF = MIN(16, LPREF) + IF (LPREF .NE. 0) CBUFF(1:LPREF) = PREFIX +C +C LWRAP IS THE MAXIMUM NUMBER OF CHARACTERS WE WANT TO TAKE AT ONE +C TIME FROM MESSG TO PRINT ON ONE LINE. +C + LWRAP = MAX(16, MIN(132, NWRAP)) +C +C SET LENMSG TO THE LENGTH OF MESSG, IGNORE ANY TRAILING BLANKS. +C + LENMSG = LEN(MESSG) + N = LENMSG + DO 20 I=1,N + IF (MESSG(LENMSG:LENMSG) .NE. ' ') GO TO 30 + LENMSG = LENMSG - 1 + 20 CONTINUE + 30 CONTINUE +C +C IF THE MESSAGE IS ALL BLANKS, THEN PRINT ONE BLANK LINE. +C + IF (LENMSG .EQ. 0) THEN + CBUFF(LPREF+1:LPREF+1) = ' ' + DO 40 I=1,NUNIT + WRITE(IU(I), '(A)') CBUFF(1:LPREF+1) + 40 CONTINUE + RETURN + ENDIF +C +C SET NEXTC TO THE POSITION IN MESSG WHERE THE NEXT SUBSTRING +C STARTS. FROM THIS POSITION WE SCAN FOR THE NEW LINE SENTINEL. +C WHEN NEXTC EXCEEDS LENMSG, THERE IS NO MORE TO PRINT. +C WE LOOP BACK TO LABEL 50 UNTIL ALL PIECES HAVE BEEN PRINTED. +C +C WE LOOK FOR THE NEXT OCCURRENCE OF THE NEW LINE SENTINEL. THE +C INDEX INTRINSIC FUNCTION RETURNS ZERO IF THERE IS NO OCCURRENCE +C OR IF THE LENGTH OF THE FIRST ARGUMENT IS LESS THAN THE LENGTH +C OF THE SECOND ARGUMENT. +C +C THERE ARE SEVERAL CASES WHICH SHOULD BE CHECKED FOR IN THE +C FOLLOWING ORDER. WE ARE ATTEMPTING TO SET LPIECE TO THE NUMBER +C OF CHARACTERS THAT SHOULD BE TAKEN FROM MESSG STARTING AT +C POSITION NEXTC. +C +C LPIECE .EQ. 0 THE NEW LINE SENTINEL DOES NOT OCCUR IN THE +C REMAINDER OF THE CHARACTER STRING. LPIECE +C SHOULD BE SET TO LWRAP OR LENMSG+1-NEXTC, +C WHICHEVER IS LESS. +C +C LPIECE .EQ. 1 THE NEW LINE SENTINEL STARTS AT MESSG(NEXTC: +C NEXTC). LPIECE IS EFFECTIVELY ZERO, AND WE +C PRINT NOTHING TO AVOID PRODUCING UNNECESSARY +C BLANK LINES. THIS TAKES CARE OF THE SITUATION +C WHERE THE LIBRARY ROUTINE HAS A MESSAGE OF +C EXACTLY 72 CHARACTERS FOLLOWED BY A NEW LINE +C SENTINEL FOLLOWED BY MORE CHARACTERS. NEXTC +C SHOULD BE INCREMENTED BY 2. +C +C LPIECE .GT. LWRAP+1 REDUCE LPIECE TO LWRAP. +C +C ELSE THIS LAST CASE MEANS 2 .LE. LPIECE .LE. LWRAP+1 +C RESET LPIECE = LPIECE-1. NOTE THAT THIS +C PROPERLY HANDLES THE END CASE WHERE LPIECE .EQ. +C LWRAP+1. THAT IS, THE SENTINEL FALLS EXACTLY +C AT THE END OF A LINE. +C + NEXTC = 1 + 50 LPIECE = INDEX(MESSG(NEXTC:LENMSG), NEWLIN) + IF (LPIECE .EQ. 0) THEN +C +C THERE WAS NO NEW LINE SENTINEL FOUND. +C + IDELTA = 0 + LPIECE = MIN(LWRAP, LENMSG+1-NEXTC) + IF (LPIECE .LT. LENMSG+1-NEXTC) THEN + DO 52 I=LPIECE+1,2,-1 + IF (MESSG(NEXTC+I-1:NEXTC+I-1) .EQ. ' ') THEN + LPIECE = I-1 + IDELTA = 1 + GOTO 54 + ENDIF + 52 CONTINUE + ENDIF + 54 CBUFF(LPREF+1:LPREF+LPIECE) = MESSG(NEXTC:NEXTC+LPIECE-1) + NEXTC = NEXTC + LPIECE + IDELTA + ELSEIF (LPIECE .EQ. 1) THEN +C +C WE HAVE A NEW LINE SENTINEL AT MESSG(NEXTC:NEXTC+1). +C DON'T PRINT A BLANK LINE. +C + NEXTC = NEXTC + 2 + GO TO 50 + ELSEIF (LPIECE .GT. LWRAP+1) THEN +C +C LPIECE SHOULD BE SET DOWN TO LWRAP. +C + IDELTA = 0 + LPIECE = LWRAP + DO 56 I=LPIECE+1,2,-1 + IF (MESSG(NEXTC+I-1:NEXTC+I-1) .EQ. ' ') THEN + LPIECE = I-1 + IDELTA = 1 + GOTO 58 + ENDIF + 56 CONTINUE + 58 CBUFF(LPREF+1:LPREF+LPIECE) = MESSG(NEXTC:NEXTC+LPIECE-1) + NEXTC = NEXTC + LPIECE + IDELTA + ELSE +C +C IF WE ARRIVE HERE, IT MEANS 2 .LE. LPIECE .LE. LWRAP+1. +C WE SHOULD DECREMENT LPIECE BY ONE. +C + LPIECE = LPIECE - 1 + CBUFF(LPREF+1:LPREF+LPIECE) = MESSG(NEXTC:NEXTC+LPIECE-1) + NEXTC = NEXTC + LPIECE + 2 + ENDIF +C +C PRINT +C + DO 60 I=1,NUNIT + WRITE(IU(I), '(A)') CBUFF(1:LPREF+LPIECE) + 60 CONTINUE +C + IF (NEXTC .LE. LENMSG) GO TO 50 + RETURN + END diff --git a/external/SLATEC/src/xersve.f b/external/SLATEC/src/xersve.f new file mode 100644 index 0000000..6bd2a4f --- /dev/null +++ b/external/SLATEC/src/xersve.f @@ -0,0 +1,155 @@ +*DECK XERSVE + SUBROUTINE XERSVE (LIBRAR, SUBROU, MESSG, KFLAG, NERR, LEVEL, + + ICOUNT) +C***BEGIN PROLOGUE XERSVE +C***SUBSIDIARY +C***PURPOSE Record that an error has occurred. +C***LIBRARY SLATEC (XERROR) +C***CATEGORY R3 +C***TYPE ALL (XERSVE-A) +C***KEYWORDS ERROR, XERROR +C***AUTHOR Jones, R. E., (SNLA) +C***DESCRIPTION +C +C *Usage: +C +C INTEGER KFLAG, NERR, LEVEL, ICOUNT +C CHARACTER * (len) LIBRAR, SUBROU, MESSG +C +C CALL XERSVE (LIBRAR, SUBROU, MESSG, KFLAG, NERR, LEVEL, ICOUNT) +C +C *Arguments: +C +C LIBRAR :IN is the library that the message is from. +C SUBROU :IN is the subroutine that the message is from. +C MESSG :IN is the message to be saved. +C KFLAG :IN indicates the action to be performed. +C when KFLAG > 0, the message in MESSG is saved. +C when KFLAG=0 the tables will be dumped and +C cleared. +C when KFLAG < 0, the tables will be dumped and +C not cleared. +C NERR :IN is the error number. +C LEVEL :IN is the error severity. +C ICOUNT :OUT the number of times this message has been seen, +C or zero if the table has overflowed and does not +C contain this message specifically. When KFLAG=0, +C ICOUNT will not be altered. +C +C *Description: +C +C Record that this error occurred and possibly dump and clear the +C tables. +C +C***REFERENCES R. E. Jones and D. K. Kahaner, XERROR, the SLATEC +C Error-handling Package, SAND82-0800, Sandia +C Laboratories, 1982. +C***ROUTINES CALLED I1MACH, XGETUA +C***REVISION HISTORY (YYMMDD) +C 800319 DATE WRITTEN +C 861211 REVISION DATE from Version 3.2 +C 891214 Prologue converted to Version 4.0 format. (BAB) +C 900413 Routine modified to remove reference to KFLAG. (WRB) +C 900510 Changed to add LIBRARY NAME and SUBROUTINE to calling +C sequence, use IF-THEN-ELSE, make number of saved entries +C easily changeable, changed routine name from XERSAV to +C XERSVE. (RWC) +C 910626 Added LIBTAB and SUBTAB to SAVE statement. (BKS) +C 920501 Reformatted the REFERENCES section. (WRB) +C***END PROLOGUE XERSVE + PARAMETER (LENTAB=10) + INTEGER LUN(5) + CHARACTER*(*) LIBRAR, SUBROU, MESSG + CHARACTER*8 LIBTAB(LENTAB), SUBTAB(LENTAB), LIB, SUB + CHARACTER*20 MESTAB(LENTAB), MES + DIMENSION NERTAB(LENTAB), LEVTAB(LENTAB), KOUNT(LENTAB) + SAVE LIBTAB, SUBTAB, MESTAB, NERTAB, LEVTAB, KOUNT, KOUNTX, NMSG + DATA KOUNTX/0/, NMSG/0/ +C***FIRST EXECUTABLE STATEMENT XERSVE +C + IF (KFLAG.LE.0) THEN +C +C Dump the table. +C + IF (NMSG.EQ.0) RETURN +C +C Print to each unit. +C + CALL XGETUA (LUN, NUNIT) + DO 20 KUNIT = 1,NUNIT + IUNIT = LUN(KUNIT) + IF (IUNIT.EQ.0) IUNIT = I1MACH(4) +C +C Print the table header. +C + WRITE (IUNIT,9000) +C +C Print body of table. +C + DO 10 I = 1,NMSG + WRITE (IUNIT,9010) LIBTAB(I), SUBTAB(I), MESTAB(I), + * NERTAB(I),LEVTAB(I),KOUNT(I) + 10 CONTINUE +C +C Print number of other errors. +C + IF (KOUNTX.NE.0) WRITE (IUNIT,9020) KOUNTX + WRITE (IUNIT,9030) + 20 CONTINUE +C +C Clear the error tables. +C + IF (KFLAG.EQ.0) THEN + NMSG = 0 + KOUNTX = 0 + ENDIF + ELSE +C +C PROCESS A MESSAGE... +C SEARCH FOR THIS MESSG, OR ELSE AN EMPTY SLOT FOR THIS MESSG, +C OR ELSE DETERMINE THAT THE ERROR TABLE IS FULL. +C + LIB = LIBRAR + SUB = SUBROU + MES = MESSG + DO 30 I = 1,NMSG + IF (LIB.EQ.LIBTAB(I) .AND. SUB.EQ.SUBTAB(I) .AND. + * MES.EQ.MESTAB(I) .AND. NERR.EQ.NERTAB(I) .AND. + * LEVEL.EQ.LEVTAB(I)) THEN + KOUNT(I) = KOUNT(I) + 1 + ICOUNT = KOUNT(I) + RETURN + ENDIF + 30 CONTINUE +C + IF (NMSG.LT.LENTAB) THEN +C +C Empty slot found for new message. +C + NMSG = NMSG + 1 + LIBTAB(I) = LIB + SUBTAB(I) = SUB + MESTAB(I) = MES + NERTAB(I) = NERR + LEVTAB(I) = LEVEL + KOUNT (I) = 1 + ICOUNT = 1 + ELSE +C +C Table is full. +C + KOUNTX = KOUNTX+1 + ICOUNT = 0 + ENDIF + ENDIF + RETURN +C +C Formats. +C + 9000 FORMAT ('0 ERROR MESSAGE SUMMARY' / + + ' LIBRARY SUBROUTINE MESSAGE START NERR', + + ' LEVEL COUNT') + 9010 FORMAT (1X,A,3X,A,3X,A,3I10) + 9020 FORMAT ('0OTHER ERRORS NOT INDIVIDUALLY TABULATED = ', I10) + 9030 FORMAT (1X) + END diff --git a/external/SLATEC/src/xgetua.f b/external/SLATEC/src/xgetua.f new file mode 100644 index 0000000..2e7db02 --- /dev/null +++ b/external/SLATEC/src/xgetua.f @@ -0,0 +1,51 @@ +*DECK XGETUA + SUBROUTINE XGETUA (IUNITA, N) +C***BEGIN PROLOGUE XGETUA +C***PURPOSE Return unit number(s) to which error messages are being +C sent. +C***LIBRARY SLATEC (XERROR) +C***CATEGORY R3C +C***TYPE ALL (XGETUA-A) +C***KEYWORDS ERROR, XERROR +C***AUTHOR Jones, R. E., (SNLA) +C***DESCRIPTION +C +C Abstract +C XGETUA may be called to determine the unit number or numbers +C to which error messages are being sent. +C These unit numbers may have been set by a call to XSETUN, +C or a call to XSETUA, or may be a default value. +C +C Description of Parameters +C --Output-- +C IUNIT - an array of one to five unit numbers, depending +C on the value of N. A value of zero refers to the +C default unit, as defined by the I1MACH machine +C constant routine. Only IUNIT(1),...,IUNIT(N) are +C defined by XGETUA. The values of IUNIT(N+1),..., +C IUNIT(5) are not defined (for N .LT. 5) or altered +C in any way by XGETUA. +C N - the number of units to which copies of the +C error messages are being sent. N will be in the +C range from 1 to 5. +C +C***REFERENCES R. E. Jones and D. K. Kahaner, XERROR, the SLATEC +C Error-handling Package, SAND82-0800, Sandia +C Laboratories, 1982. +C***ROUTINES CALLED J4SAVE +C***REVISION HISTORY (YYMMDD) +C 790801 DATE WRITTEN +C 861211 REVISION DATE from Version 3.2 +C 891214 Prologue converted to Version 4.0 format. (BAB) +C 920501 Reformatted the REFERENCES section. (WRB) +C***END PROLOGUE XGETUA + DIMENSION IUNITA(5) +C***FIRST EXECUTABLE STATEMENT XGETUA + N = J4SAVE(5,0,.FALSE.) + DO 30 I=1,N + INDEX = I+4 + IF (I.EQ.1) INDEX = 3 + IUNITA(I) = J4SAVE(INDEX,0,.FALSE.) + 30 CONTINUE + RETURN + END diff --git a/pixi.lock b/pixi.lock new file mode 100644 index 0000000..95fbe93 --- /dev/null +++ b/pixi.lock @@ -0,0 +1,849 @@ +version: 7 +platforms: +- name: linux-64 + virtual-packages: + - __unix=0 + - __linux=4.18 + - __glibc=2.28 + - __archspec=0=x86_64 +environments: + default: + channels: + - url: https://conda.anaconda.org/conda-forge/ + packages: + linux-64: + - conda: https://conda.anaconda.org/conda-forge/linux-64/_openmp_mutex-4.5-20_gnu.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/gsl-2.8-h3cd6761_2.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libblas-3.11.0-12_h4a7cf45_openblas.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libcblas-3.11.0-12_h0358290_openblas.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libgcc-16.2.0-ha9f2e26_7.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libgfortran-16.2.0-h69a702a_7.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libgfortran5-16.2.0-h6b99dfc_7.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libgomp-16.2.0-he0feb66_7.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libopenblas-0.3.34-pthreads_hf13c14d_2.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libopenblas-ilp64-0.3.34-pthreads_h79482e6_2.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libstdcxx-16.2.0-h934c35e_7.conda + - conda_source: mess[b5469410] @ . + static: + channels: + - url: https://conda.anaconda.org/conda-forge/ + packages: + linux-64: + - conda_source: mess-static[5770cfd9] @ static +packages: +- conda: https://conda.anaconda.org/conda-forge/linux-64/_openmp_mutex-4.5-20_gnu.conda + build_number: 20 + sha256: 1dd3fffd892081df9726d7eb7e0dea6198962ba775bd88842135a4ddb4deb3c9 + md5: a9f577daf3de00bca7c3c76c0ecbd1de + depends: + - __glibc >=2.17,<3.0.a0 + - libgomp >=7.5.0 + constrains: + - openmp_impl <0.0a0 + license: BSD-3-Clause + license_family: BSD + run_exports: + strong: + - _openmp_mutex >=4.5 + size: 28948 + timestamp: 1770939786096 +- conda: https://conda.anaconda.org/conda-forge/linux-64/binutils_impl_linux-64-2.46.1-default_hfdba357_103.conda + sha256: 98f9ddc6dc5d56a824b7eaea5bab6ad4bb47642288fc70d6b1b4024ac39d5595 + md5: e86f9dc615d7533c5be8b15b3a1dee8d + depends: + - ld_impl_linux-64 2.46.1 default_hbd61a6d_103 + - sysroot_linux-64 + - zstd >=1.5.7,<1.6.0a0 + license: GPL-3.0-only + license_family: GPL + run_exports: {} + size: 3706604 + timestamp: 1791565481839 +- conda: https://conda.anaconda.org/conda-forge/linux-64/binutils_linux-64-2.46.1-default_h4852527_103.conda + sha256: 606a42c754752fb905fe2012d52ff370d47b5b6adefd5f7befc4ec30ce758f23 + md5: ca26f0a4f8d04fd83147af557fbd932c + depends: + - binutils_impl_linux-64 2.46.1 default_hfdba357_103 + license: GPL-3.0-only + license_family: GPL + run_exports: {} + size: 36335 + timestamp: 1791565508736 +- conda: https://conda.anaconda.org/conda-forge/linux-64/bzip2-1.0.8-hda65f42_10.conda + sha256: 1a0d382c515ebf55f8ee1f38c8b81bc95af5c2acc42ad53b66bc5df932032f96 + md5: e675fabcf81499adc7edf58124fb1e01 + depends: + - __glibc >=2.17,<3.0.a0 + - libgcc >=14 + license: bzip2-1.0.6 + license_family: BSD + run_exports: + weak: + - bzip2 >=1.0.8,<2.0a0 + size: 257808 + timestamp: 1785906269155 +- conda: https://conda.anaconda.org/conda-forge/linux-64/c-ares-1.34.9-hebe6cf0_0.conda + sha256: bd95dd25b80b5c4faf5349542377bf89b2794e23d0f7aa7f1c431e4f3b633f3c + md5: 78b505af04bf7a87ca957ef0cb5946f5 + depends: + - __glibc >=2.17,<3.0.a0 + - libgcc >=15 + license: MIT + license_family: MIT + run_exports: + weak: + - c-ares >=1.34.9,<2.0a0 + size: 233759 + timestamp: 1792507024648 +- conda: https://conda.anaconda.org/conda-forge/linux-64/cmake-4.4.5-hff7ac6b_0.conda + sha256: 2fdc108bc51a8845fc1c25e1cb78f6781bdce439f637ff850c2fa9a5a92c56f6 + md5: e18e63b15ab8bf430536d4f76abef6ad + depends: + - __glibc >=2.17,<3.0.a0 + - libgcc >=15 + - libstdcxx >=15 + - libzlib >=1.3.2,<2.0a0 + - ncurses >=6.6,<7.0a0 + - libcurl >=8.23.0,<9.0a0 + - bzip2 >=1.0.8,<2.0a0 + - liblzma >=5.8.3,<6.0a0 + - libexpat >=2.9.0,<3.0a0 + - rhash >=1.4.6,<2.0a0 + - libuv >=1.52.1,<2.0a0 + - zstd >=1.5.7,<1.6.0a0 + license: BSD-3-Clause + license_family: BSD + run_exports: {} + size: 26078149 + timestamp: 1793157027565 +- conda: https://conda.anaconda.org/conda-forge/linux-64/gcc_impl_linux-64-16.2.0-h9891192_7.conda + sha256: 14acaa661e4c4ef6c65606612b8b08f8f079c6a9e6da3ffcb77056685c675651 + md5: f548b09900fed2701931f8cf925d8b9b + depends: + - binutils_impl_linux-64 >=2.46.1 + - libgcc >=16.2.0 + - libgcc-devel_linux-64 16.2.0 he3ce08f_107 + - libgomp >=16.2.0 + - libsanitizer 16.2.0 h3048135_7 + - libstdcxx >=16.2.0 + - libstdcxx-devel_linux-64 16.2.0 h86e191b_107 + - sysroot_linux-64 + license: GPL-3.0-only WITH GCC-exception-3.1 + license_family: GPL + run_exports: {} + size: 86085260 + timestamp: 1790303193926 +- conda: https://conda.anaconda.org/conda-forge/linux-64/gcc_linux-64-16.2.0-h0ab548f_2.conda + sha256: b9817e310019a9c8b79e46335c87e478c7646d2fcc727cc53bb5a3e8ce276c1d + md5: 3928593d74a0b17f84fba5977cb7023d + depends: + - gcc_impl_linux-64 16.2.0.* + - binutils_linux-64 + - sysroot_linux-64 + license: BSD-3-Clause + license_family: BSD + run_exports: + strong: + - libgcc >=16 + size: 30371 + timestamp: 1789573357529 +- conda: https://conda.anaconda.org/conda-forge/linux-64/gfortran_impl_linux-64-16.2.0-hf930d89_7.conda + sha256: 263277d04b6d7cc8cb02f73977ff6ae77bbb0b14f8b355667bc337f3fa454ef3 + md5: b8fa9e9457b9e75f2bf85ad8017fa1d7 + depends: + - gcc_impl_linux-64 16.2.0.* + - libgcc >=16.2.0 + - libgfortran5 >=16.2.0 + - libstdcxx >=16.2.0 + - sysroot_linux-64 + license: GPL-3.0-only WITH GCC-exception-3.1 + license_family: GPL + run_exports: {} + size: 21139940 + timestamp: 1790303329678 +- conda: https://conda.anaconda.org/conda-forge/linux-64/gfortran_linux-64-16.2.0-h57f15ab_2.conda + sha256: 24ccd88b6b6e43f40849280495498394b22d8a2e4a15f8d98edaf691656e3f76 + md5: 34feaf8c7d63d268345e664574b1e1d6 + depends: + - gfortran_impl_linux-64 16.2.0.* + - gcc_linux-64 ==16.2.0 h0ab548f_2 + - binutils_linux-64 + - sysroot_linux-64 + license: BSD-3-Clause + license_family: BSD + run_exports: + strong: + - libgfortran5 >=16.2.0 + - libgfortran + - libgcc >=16 + size: 28204 + timestamp: 1789573357529 +- conda: https://conda.anaconda.org/conda-forge/linux-64/gsl-2.8-h3cd6761_2.conda + sha256: 433d1b1570afa09f469fa5cfb633a2d860fe270639ffa6ba7a354088ab5aba23 + md5: 5071d6d2577a3d5989b1767fbd0a4d56 + depends: + - __glibc >=2.17,<3.0.a0 + - libblas >=3.9.0,<4.0a0 + - libcblas >=3.9.0,<4.0a0 + - libgcc >=15 + license: GPL-3.0-or-later + license_family: GPL + run_exports: + weak: + - gsl >=2.8,<2.9.0a0 + size: 2466796 + timestamp: 1789041589598 +- conda: https://conda.anaconda.org/conda-forge/linux-64/gxx_impl_linux-64-16.2.0-h0d273dc_7.conda + sha256: f873532a86ce9073a7255dec909472c2a271a57db938f383b630a3caa0b47709 + md5: ea011fbfe6ce5b3a74a8e34fc9c8481a + depends: + - gcc_impl_linux-64 16.2.0 h9891192_7 + - libstdcxx-devel_linux-64 16.2.0 h86e191b_107 + - sysroot_linux-64 + - tzdata + license: GPL-3.0-only WITH GCC-exception-3.1 + license_family: GPL + run_exports: {} + size: 16987505 + timestamp: 1790303362251 +- conda: https://conda.anaconda.org/conda-forge/linux-64/gxx_linux-64-16.2.0-h23aca61_2.conda + sha256: b3dfa09210788fff127a5b7f3aa0ab1f9a83627ae7bd45e8aa5bb6dcf9039bef + md5: 38b21695fc42aa9bf6d4883e45a80fd9 + depends: + - gxx_impl_linux-64 16.2.0.* + - gcc_linux-64 ==16.2.0 h0ab548f_2 + - binutils_linux-64 + - sysroot_linux-64 + license: BSD-3-Clause + license_family: BSD + run_exports: + strong: + - libstdcxx >=16 + - libgcc >=16 + size: 28780 + timestamp: 1789573357529 +- conda: https://conda.anaconda.org/conda-forge/linux-64/icu-79.1-py314hb486520_0.conda + sha256: 9a339bedff62e63bb949383edc656956abef1f23663c879f7fcb66a004a18ef9 + md5: 0be836734696f6476615ef0e97b388a3 + depends: + - __glibc >=2.17,<3.0.a0 + - libstdcxx >=15 + - libgcc >=15 + license: MIT + license_family: MIT + run_exports: + weak: + - icu >=79.1,<80.0a0 + size: 14540104 + timestamp: 1792691528355 +- conda: https://conda.anaconda.org/conda-forge/linux-64/keyutils-1.6.3-h7cc23a3_1.conda + sha256: dd053c96dcb0dcfd59422aefea9d2fe937a190167f34fba7893ec1e10a7e8963 + md5: ba55d1b89fd7775e67de8291029b4059 + depends: + - __glibc >=2.17,<3.0.a0 + - libgcc >=15 + license: LGPL-2.1-or-later + run_exports: + weak: + - keyutils >=1.6.3,<2.0a0 + size: 135295 + timestamp: 1786739238128 +- conda: https://conda.anaconda.org/conda-forge/linux-64/krb5-1.22.2-hbc21106_2.conda + sha256: 2a5c38c85e63df84c4e69ee71439841ce570d259ae3060627bb9a49a938d66f4 + md5: 53318d715316929a574f83591308b1f8 + depends: + - __glibc >=2.17,<3.0.a0 + - keyutils >=1.6.3,<2.0a0 + - libedit >=3.1.20250104,<3.2.0a0 + - libedit >=3.1.20250104,<4.0a0 + - libgcc >=15 + - libstdcxx >=15 + - openssl >=3.5.7,<4.0a0 + license: MIT + license_family: MIT + run_exports: + weak: + - krb5 >=1.22.2,<1.23.0a0 + size: 1394333 + timestamp: 1786762112514 +- conda: https://conda.anaconda.org/conda-forge/linux-64/ld_impl_linux-64-2.46.1-default_hbd61a6d_103.conda + sha256: 901649b1edbe841fd4ee7e2d491a05184ed540eb01cdae506872f344babc1d28 + md5: 2362c70e7e79827c32db35547d9c179b + depends: + - __glibc >=2.17,<3.0.a0 + - zstd >=1.5.7,<1.6.0a0 + constrains: + - binutils_impl_linux-64 2.46.1 + license: GPL-3.0-only + license_family: GPL + run_exports: {} + size: 742109 + timestamp: 1791565468810 +- conda: https://conda.anaconda.org/conda-forge/linux-64/libblas-3.11.0-12_h4a7cf45_openblas.conda + build_number: 12 + sha256: 6a6263c3d4a484dbac4ae7a8191be5f868c0574bbc7faa42b258bb59dc6d5fa2 + md5: d718330824f78deef9ca46fe62a33820 + depends: + - libopenblas >=0.3.34,<0.3.35.0a0 + - libopenblas >=0.3.34,<1.0a0 + constrains: + - blas 2.312 openblas + - libcblas 3.11.0 12*_openblas + - liblapack 3.11.0 12*_openblas + - liblapacke 3.11.0 12*_openblas + - mkl <2027 + license: BSD-3-Clause + license_family: BSD + run_exports: + weak: + - libblas >=3.11.0,<4.0a0 + size: 18102 + timestamp: 1793822074865 +- conda: https://conda.anaconda.org/conda-forge/linux-64/libcblas-3.11.0-12_h0358290_openblas.conda + build_number: 12 + sha256: 8ea7d98b71e1200e2e4141c1813d6950e6acc917d220bbf54058390d252460f8 + md5: 074ad2000c240d26e791e6aa9d055e30 + depends: + - libblas 3.11.0 12_h4a7cf45_openblas + constrains: + - blas 2.312 openblas + - liblapack 3.11.0 12*_openblas + - liblapacke 3.11.0 12*_openblas + license: BSD-3-Clause + license_family: BSD + run_exports: + weak: + - libcblas >=3.11.0,<4.0a0 + size: 18098 + timestamp: 1793822078553 +- conda: https://conda.anaconda.org/conda-forge/linux-64/libcurl-8.23.0-ha042cf0_0.conda + sha256: d2db14d80efb4f2e76e76561c633f1767f7543987f2bcb54a067a9d264d432ab + md5: 0ad16151226df493aed967f0efce0e80 + depends: + - __glibc >=2.17,<3.0.a0 + - krb5 >=1.22.2,<1.23.0a0 + - libgcc >=15 + - libnghttp2 >=1.68.1,<2.0a0 + - libpsl >=0.23.1,<0.24.0a0 + - libssh2 >=1.11.1,<2.0a0 + - libzlib >=1.3.2,<2.0a0 + - openssl >=3.5.9,<4.0a0 + - zstd >=1.5.7,<1.6.0a0 + license: curl + license_family: MIT + run_exports: + weak: + - libcurl >=8.23.0,<9.0a0 + size: 505683 + timestamp: 1791990900844 +- conda: https://conda.anaconda.org/conda-forge/linux-64/libedit-3.1.20260512-pl5321h373387f_0.conda + sha256: 45301f14f4eb66da57cfaf2d265f3eeee73f8b07e99614ee3afc5b26eea91126 + md5: 27dbd7e2984b8fe48e069379636ccfdd + depends: + - ncurses + - __glibc >=2.17,<3.0.a0 + - libgcc >=14 + - ncurses >=6.6,<7.0a0 + license: BSD-2-Clause + license_family: BSD + run_exports: + weak: + - libedit >=3.1.20260512,<3.2.0a0 + size: 135877 + timestamp: 1791327370514 +- conda: https://conda.anaconda.org/conda-forge/linux-64/libev-4.33-h280c20c_3.conda + sha256: e4418f68d01a6307c4431b585c71b584f40189877364e542ee87deb777f5e85b + md5: 7bc31538d6e3fb349e897353969237ec + depends: + - libgcc >=14 + - __glibc >=2.17,<3.0.a0 + license: BSD-2-Clause OR GPL-2.0-or-later + license_family: GPL + run_exports: + weak: + - libev >=4.33,<4.34.0a0 + size: 43220 + timestamp: 1785917328200 +- conda: https://conda.anaconda.org/conda-forge/linux-64/libexpat-2.9.0-hd2095e1_0.conda + sha256: 7b930a8b6bc6553cb754b4977a11f9c862c719a652fc2d128d89270992ce8beb + md5: 317ecabe4a58b3068c7958dc5eb89e43 + depends: + - __glibc >=2.17,<3.0.a0 + - libgcc >=15 + constrains: + - expat 2.9.0.* + license: MIT + license_family: MIT + run_exports: {} + size: 78894 + timestamp: 1793054221966 +- conda: https://conda.anaconda.org/conda-forge/linux-64/libgcc-16.2.0-ha9f2e26_7.conda + sha256: e031634c3a928f9594eba868bc46ef5230d6571a364a0c63215b06c4563bfcea + md5: 735629b400b70eeab21a2ba8f5b1c2ce + depends: + - __glibc >=2.17,<3.0.a0 + - _openmp_mutex >=4.5 + constrains: + - libgcc-ng ==16.2.0=*_7 + - libgomp 16.2.0 he0feb66_7 + license: GPL-3.0-only WITH GCC-exception-3.1 + license_family: GPL + run_exports: {} + size: 1058444 + timestamp: 1790303109576 +- conda: https://conda.anaconda.org/conda-forge/linux-64/libgfortran-16.2.0-h69a702a_7.conda + sha256: 9682ae4dd11487e10b904b3cb3ab6379cad25233d45fdfdf90d54349df244494 + md5: 3a8d285f5f22138ef826ad54cf267e73 + depends: + - libgfortran5 16.2.0 h6b99dfc_7 + constrains: + - libgfortran-ng ==16.2.0=*_7 + license: GPL-3.0-only WITH GCC-exception-3.1 + license_family: GPL + run_exports: {} + size: 28571 + timestamp: 1790303139904 +- conda: https://conda.anaconda.org/conda-forge/linux-64/libgfortran5-16.2.0-h6b99dfc_7.conda + sha256: 04dbab12c925b92977bb835dd2f5eda413607afa79f95a554e5a04b07a380322 + md5: 7719ed7be38ad8c492c4bd5cc2bce0c4 + depends: + - __glibc >=2.17,<3.0.a0 + - libgcc >=16.2.0 + constrains: + - libgfortran 16.2.0 + license: GPL-3.0-only WITH GCC-exception-3.1 + license_family: GPL + run_exports: {} + size: 2528180 + timestamp: 1790303122004 +- conda: https://conda.anaconda.org/conda-forge/linux-64/libgomp-16.2.0-he0feb66_7.conda + sha256: 92a0bb350c7be6a4eedcb4e111c60aefd176018e6b1c009a6e025dbe9bbcd758 + md5: d904c7ddd95e026254b4b80808ee9e12 + depends: + - __glibc >=2.17,<3.0.a0 + license: GPL-3.0-only WITH GCC-exception-3.1 + license_family: GPL + run_exports: + strong: + - _openmp_mutex >=4.5 + size: 640566 + timestamp: 1790303046034 +- conda: https://conda.anaconda.org/conda-forge/linux-64/liblzma-5.8.3-hb03c661_1.conda + sha256: 9787df8c22a59c9a70d3e5a10db9ad663485e75e9ccc3f09bd092cb7b95e0dab + md5: 1390b7c5ac0b1d8e447bc5efa6d3c8c2 + depends: + - __glibc >=2.17,<3.0.a0 + - libgcc >=14 + constrains: + - xz 5.8.3.* + license: 0BSD + run_exports: + weak: + - liblzma >=5.8.3,<6.0a0 + size: 112995 + timestamp: 1786348617826 +- conda: https://conda.anaconda.org/conda-forge/linux-64/libnghttp2-1.71.0-hc5e5977_0.conda + sha256: a4386712ad6d5bc18943b198407c39e2f8ae2fa9c6418bb37bba96f1d382f109 + md5: 726df214814a8b06135a6a674bc54589 + depends: + - libev >=4.33,<5.0a0 + - __glibc >=2.17,<3.0.a0 + - libgcc >=15 + - libstdcxx >=15 + - libev >=4.33,<4.34.0a0 + - c-ares >=1.34.9,<2.0a0 + - libzlib >=1.3.2,<2.0a0 + - openssl >=3.5.9,<4.0a0 + license: MIT + license_family: MIT + run_exports: + weak: + - libnghttp2 >=1.71.0,<2.0a0 + size: 822778 + timestamp: 1793628201366 +- conda: https://conda.anaconda.org/conda-forge/linux-64/libopenblas-0.3.34-pthreads_hf13c14d_2.conda + sha256: 69a722751e14eab2eb3bfdcb9acb1187afbd962b0c49b48d829341e0f6787f60 + md5: 7e19fcd73d7f0997d3cb3326d2586a86 + depends: + - libgfortran5 >=15.3.0 + - libgfortran + - libgcc >=15 + - __glibc >=2.17,<3.0.a0 + constrains: + - openblas >=0.3.34,<0.3.35.0a0 + license: BSD-3-Clause + license_family: BSD + run_exports: + weak: + - libopenblas >=0.3.34,<1.0a0 + size: 6845411 + timestamp: 1789141490688 +- conda: https://conda.anaconda.org/conda-forge/linux-64/libopenblas-ilp64-0.3.34-pthreads_h79482e6_2.conda + sha256: 4fefaeb75e02ceac61d53cd1c6344fb25deba2352707167c1ec3534ba85dad4f + md5: b2e8ccaf63d7a8aa45eca13b45658bea + depends: + - libgfortran5 >=15.3.0 + - libgfortran + - libgcc >=15 + - __glibc >=2.17,<3.0.a0 + constrains: + - openblas-ilp64 >=0.3.34,<0.3.35.0a0 + license: BSD-3-Clause + license_family: BSD + run_exports: + weak: + - libopenblas-ilp64 >=0.3.34,<1.0a0 + size: 6722597 + timestamp: 1789141486540 +- conda: https://conda.anaconda.org/conda-forge/linux-64/libpsl-0.23.1-h7fe8442_2.conda + sha256: 68d48a7cd3e0fc8d7980dd13467d5a2dc937c09f68ccee53b9b0c5a4f569db58 + md5: 3a377a6b03bcad2601a820b07fab0c64 + depends: + - libstdcxx >=15 + - libgcc >=15 + - __glibc >=2.17,<3.0.a0 + - icu >=79.1,<80.0a0 + license: MIT + license_family: MIT + run_exports: + weak: + - libpsl >=0.23.1,<0.24.0a0 + size: 72612 + timestamp: 1793221942214 +- conda: https://conda.anaconda.org/conda-forge/linux-64/libsanitizer-16.2.0-h3048135_7.conda + sha256: e383569c331239308a8663facb76208fc0e141131ff3d17c1c2e50f34716a5a9 + md5: 9cdd9af432fa4eb62094aaf6211425bf + depends: + - __glibc >=2.17,<3.0.a0 + - libgcc >=16.2.0 + - libstdcxx >=16.2.0 + license: GPL-3.0-only WITH GCC-exception-3.1 + license_family: GPL + run_exports: + weak: + - libsanitizer 16.2.0 + size: 8115383 + timestamp: 1790303148068 +- conda: https://conda.anaconda.org/conda-forge/linux-64/libssh2-1.11.1-h6154650_1.conda + sha256: 7e463000fa1cba3f3a6597b776f6ab301d425a96e3bc20d0d9d76a3b9f237aa3 + md5: 5c526561e1d2a2e071941174eae84557 + depends: + - __glibc >=2.17,<3.0.a0 + - libgcc >=14 + - libzlib >=1.3.2,<2.0a0 + - openssl >=3.5.7,<4.0a0 + license: BSD-3-Clause + license_family: BSD + run_exports: + weak: + - libssh2 >=1.11.1,<2.0a0 + size: 306045 + timestamp: 1786713107897 +- conda: https://conda.anaconda.org/conda-forge/linux-64/libstdcxx-16.2.0-h934c35e_7.conda + sha256: fa7018298629fc429971fffd6ecba3d27a7b02e4e890d6a93ea01ffebe8cb745 + md5: 9b6707e0caca917fa6ea9ee473f37a5d + depends: + - __glibc >=2.17,<3.0.a0 + - libgcc 16.2.0 ha9f2e26_7 + constrains: + - libstdcxx-ng ==16.2.0=*_7 + license: GPL-3.0-only WITH GCC-exception-3.1 + license_family: GPL + run_exports: {} + size: 6615436 + timestamp: 1790303132935 +- conda: https://conda.anaconda.org/conda-forge/linux-64/libuv-1.52.1-h280c20c_1.conda + sha256: 67761d0206f84140047a367eaf9befe03a7e157a29ee25aee0047b40801cc6b6 + md5: 01c4ed87826af55996768af6dbc936b4 + depends: + - libgcc >=14 + - __glibc >=2.17,<3.0.a0 + license: MIT + license_family: MIT + run_exports: + weak: + - libuv >=1.52.1,<2.0a0 + size: 420040 + timestamp: 1785914567661 +- conda: https://conda.anaconda.org/conda-forge/linux-64/libzlib-1.3.2-h25fd6f3_3.conda + sha256: eb8a0db0aa570124f7d2a93d7c7f596e3390df5e047818d873baad32985fc736 + md5: 0de0122d9570a8ab637c6b73db268389 + depends: + - __glibc >=2.17,<3.0.a0 + constrains: + - zlib 1.3.2 *_3 + license: Zlib + license_family: Other + run_exports: + weak: + - libzlib >=1.3.2,<2.0a0 + size: 63713 + timestamp: 1785362952714 +- conda: https://conda.anaconda.org/conda-forge/linux-64/ncurses-6.6-hdb14827_1.conda + sha256: 5d46557214ed184381dafe835b7c94a474a1c3b307a08a250b1ea4779b44ffb3 + md5: ee6c0cd80a60961a1f48aa3e0b91f986 + depends: + - __glibc >=2.17,<3.0.a0 + - libgcc >=14 + license: X11 AND BSD-3-Clause + run_exports: + weak: + - ncurses >=6.6,<7.0a0 + size: 911196 + timestamp: 1786355078102 +- conda: https://conda.anaconda.org/conda-forge/linux-64/ninja-1.13.2-h171cf75_1.conda + sha256: 2b5f2e865122f9fc0637f520a7cb22e16b9727b2db6761ee16cb5e6404412c81 + md5: 2db7a395d7dc2b6ed5effaf68fb99443 + depends: + - __glibc >=2.17,<3.0.a0 + - libstdcxx >=14 + - libgcc >=14 + license: Apache-2.0 + license_family: APACHE + run_exports: {} + size: 186767 + timestamp: 1786713048064 +- conda: https://conda.anaconda.org/conda-forge/linux-64/openblas-ilp64-0.3.34-pthreads_h8097de1_2.conda + sha256: a986d9e9a889d4e7b2c430b4fdb3f149eb538a335617898585b725dd8b37d355 + md5: b60f10bc4817bd472afbe0af1275a46c + depends: + - libopenblas-ilp64 ==0.3.34 pthreads_h79482e6_2 + license: BSD-3-Clause + license_family: BSD + run_exports: {} + size: 7463180 + timestamp: 1789141486540 +- conda: https://conda.anaconda.org/conda-forge/linux-64/openssl-3.6.5-h781a0a9_0.conda + sha256: 9c1533f1cf784f0e250919c0c9762d0b0e6bc727a79290ffb7cea1ceca1d038c + md5: 5a51a2ea653f120240b1a9bf76e0aae9 + depends: + - __glibc >=2.17,<3.0.a0 + - ca-certificates + - libgcc >=15 + license: Apache-2.0 + license_family: Apache + run_exports: + weak: + - openssl >=3.6.5,<4.0a0 + size: 3195299 + timestamp: 1791098052301 +- conda: https://conda.anaconda.org/conda-forge/linux-64/rhash-1.4.6-hb03c661_2.conda + sha256: 186a5b225077ad5f4656966da947d43307101950751ef4a239b455588756b4e1 + md5: 007602d697e07c11ff9864964eba5ee3 + depends: + - __glibc >=2.17,<3.0.a0 + - libgcc >=14 + license: MIT + license_family: MIT + run_exports: + weak: + - rhash >=1.4.6,<2.0a0 + size: 194994 + timestamp: 1786731436520 +- conda: https://conda.anaconda.org/conda-forge/linux-64/zstd-1.5.7-hb78ec9c_7.conda + sha256: 47d682b9f6d6ec9eb1a6e6c3e75ea6273e899e78fb7fc59f81d39745009fbc60 + md5: aa459086047c0e5e27023ab19f8cb86a + depends: + - __glibc >=2.17,<3.0.a0 + - libzlib >=1.3.2,<2.0a0 + license: BSD-3-Clause + license_family: BSD + run_exports: + weak: + - zstd >=1.5.7,<1.6.0a0 + size: 601301 + timestamp: 1786599621503 +- conda: https://conda.anaconda.org/conda-forge/noarch/ca-certificates-2026.10.23-hbd8a1cb_0.conda + sha256: 95619b9c1184be7175392eeb0ee7eeb5ccf25d280951f4225f2d62e725790be3 + md5: 3fd02989038a1e1cee627c14c2d73f29 + depends: + - __unix + license: ISC + run_exports: {} + size: 130057 + timestamp: 1792772446739 +- conda: https://conda.anaconda.org/conda-forge/noarch/kernel-headers_linux-64-4.18.0-he073ed8_9.conda + sha256: 41557eeadf641de6aeae49486cef30d02a6912d8da98585d687894afd65b356a + md5: 86d9cba083cd041bfbf242a01a7a1999 + constrains: + - sysroot_linux-64 ==2.28 + license: LGPL-2.0-or-later AND LGPL-2.0-or-later WITH exceptions AND GPL-2.0-or-later + license_family: GPL + run_exports: {} + size: 1278712 + timestamp: 1765578681495 +- conda: https://conda.anaconda.org/conda-forge/noarch/libgcc-devel_linux-64-16.2.0-he3ce08f_107.conda + sha256: f1e7465f6b53f89b325e441c30ad7b19407b051eca556b6d0386ec05513b8e76 + md5: f689d67c3e828fe80ff290d15f361bc5 + depends: + - __unix + license: GPL-3.0-only WITH GCC-exception-3.1 + license_family: GPL + run_exports: {} + size: 3099665 + timestamp: 1790302976359 +- conda: https://conda.anaconda.org/conda-forge/noarch/libstdcxx-devel_linux-64-16.2.0-h86e191b_107.conda + sha256: ebbad84bdebd8a9964020d74dcce0f211f1431878c66326f6115dcb59e4c3469 + md5: a713d3c09518a9fc8f603ac0e157263c + depends: + - __unix + license: GPL-3.0-only WITH GCC-exception-3.1 + license_family: GPL + run_exports: {} + size: 23329491 + timestamp: 1790303058123 +- conda: https://conda.anaconda.org/conda-forge/noarch/sysroot_linux-64-2.28-h4ee821c_9.conda + sha256: c47299fe37aebb0fcf674b3be588e67e4afb86225be4b0d452c7eb75c086b851 + md5: 13dc3adbc692664cd3beabd216434749 + depends: + - __glibc >=2.28 + - kernel-headers_linux-64 4.18.0 he073ed8_9 + - tzdata + license: LGPL-2.0-or-later AND LGPL-2.0-or-later WITH exceptions AND GPL-2.0-or-later + license_family: GPL + run_exports: + strong: + - __glibc >=2.28,<3.0.a0 + size: 24008591 + timestamp: 1765578833462 +- conda: https://conda.anaconda.org/conda-forge/noarch/tzdata-2026e-h5d301ff_0.conda + sha256: 2b7ca858879f183ce2dcc65b300f48a0133d5430550f35b23d80d405a0788dbf + md5: abccc3810d2b97e570dee487f2b46e38 + license: LicenseRef-Public-Domain + run_exports: {} + size: 119208 + timestamp: 1792758382821 +- conda_source: mess-static[5770cfd9] @ static + variants: + c_stdlib: sysroot + c_stdlib_version: '2.28' + target_platform: linux-64 + depends: + - __glibc >=2.28,<3.0.a0 + license: Apache-2.0 + build_packages: + - conda: https://conda.anaconda.org/conda-forge/linux-64/_openmp_mutex-4.5-20_gnu.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/binutils_impl_linux-64-2.46.1-default_hfdba357_103.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/binutils_linux-64-2.46.1-default_h4852527_103.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/bzip2-1.0.8-hda65f42_10.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/c-ares-1.34.9-hebe6cf0_0.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/cmake-4.4.5-hff7ac6b_0.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/gcc_impl_linux-64-16.2.0-h9891192_7.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/gcc_linux-64-16.2.0-h0ab548f_2.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/gfortran_impl_linux-64-16.2.0-hf930d89_7.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/gfortran_linux-64-16.2.0-h57f15ab_2.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/gxx_impl_linux-64-16.2.0-h0d273dc_7.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/gxx_linux-64-16.2.0-h23aca61_2.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/icu-79.1-py314hb486520_0.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/keyutils-1.6.3-h7cc23a3_1.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/krb5-1.22.2-hbc21106_2.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/ld_impl_linux-64-2.46.1-default_hbd61a6d_103.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libcurl-8.23.0-ha042cf0_0.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libedit-3.1.20260512-pl5321h373387f_0.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libev-4.33-h280c20c_3.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libexpat-2.9.0-hd2095e1_0.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libgcc-16.2.0-ha9f2e26_7.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libgfortran5-16.2.0-h6b99dfc_7.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libgomp-16.2.0-he0feb66_7.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/liblzma-5.8.3-hb03c661_1.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libnghttp2-1.71.0-hc5e5977_0.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libpsl-0.23.1-h7fe8442_2.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libsanitizer-16.2.0-h3048135_7.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libssh2-1.11.1-h6154650_1.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libstdcxx-16.2.0-h934c35e_7.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libuv-1.52.1-h280c20c_1.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libzlib-1.3.2-h25fd6f3_3.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/ncurses-6.6-hdb14827_1.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/ninja-1.13.2-h171cf75_1.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/openssl-3.6.5-h781a0a9_0.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/rhash-1.4.6-hb03c661_2.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/zstd-1.5.7-hb78ec9c_7.conda + - conda: https://conda.anaconda.org/conda-forge/noarch/ca-certificates-2026.10.23-hbd8a1cb_0.conda + - conda: https://conda.anaconda.org/conda-forge/noarch/kernel-headers_linux-64-4.18.0-he073ed8_9.conda + - conda: https://conda.anaconda.org/conda-forge/noarch/libgcc-devel_linux-64-16.2.0-he3ce08f_107.conda + - conda: https://conda.anaconda.org/conda-forge/noarch/libstdcxx-devel_linux-64-16.2.0-h86e191b_107.conda + - conda: https://conda.anaconda.org/conda-forge/noarch/sysroot_linux-64-2.28-h4ee821c_9.conda + - conda: https://conda.anaconda.org/conda-forge/noarch/tzdata-2026e-h5d301ff_0.conda + host_packages: + - conda: https://conda.anaconda.org/conda-forge/linux-64/_openmp_mutex-4.5-20_gnu.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/gsl-2.8-h3cd6761_2.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libblas-3.11.0-12_h4a7cf45_openblas.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libcblas-3.11.0-12_h0358290_openblas.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libgcc-16.2.0-ha9f2e26_7.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libgfortran-16.2.0-h69a702a_7.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libgfortran5-16.2.0-h6b99dfc_7.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libgomp-16.2.0-he0feb66_7.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libopenblas-0.3.34-pthreads_hf13c14d_2.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libopenblas-ilp64-0.3.34-pthreads_h79482e6_2.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/openblas-ilp64-0.3.34-pthreads_h8097de1_2.conda +- conda_source: mess[b5469410] @ . + variants: + c_stdlib: sysroot + c_stdlib_version: '2.28' + target_platform: linux-64 + depends: + - __glibc >=2.28,<3.0.a0 + - gsl >=2.8,<2.9.0a0 + - libgcc >=16 + - libgcc >=16 + - libgcc >=16 + - libgfortran * + - libgfortran5 >=16.2.0 + - libopenblas-ilp64 >=0.3.34,<1.0a0 + - libstdcxx >=16 + build_packages: + - conda: https://conda.anaconda.org/conda-forge/linux-64/_openmp_mutex-4.5-20_gnu.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/binutils_impl_linux-64-2.46.1-default_hfdba357_103.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/binutils_linux-64-2.46.1-default_h4852527_103.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/bzip2-1.0.8-hda65f42_10.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/c-ares-1.34.9-hebe6cf0_0.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/cmake-4.4.5-hff7ac6b_0.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/gcc_impl_linux-64-16.2.0-h9891192_7.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/gcc_linux-64-16.2.0-h0ab548f_2.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/gfortran_impl_linux-64-16.2.0-hf930d89_7.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/gfortran_linux-64-16.2.0-h57f15ab_2.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/gxx_impl_linux-64-16.2.0-h0d273dc_7.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/gxx_linux-64-16.2.0-h23aca61_2.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/icu-79.1-py314hb486520_0.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/keyutils-1.6.3-h7cc23a3_1.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/krb5-1.22.2-hbc21106_2.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/ld_impl_linux-64-2.46.1-default_hbd61a6d_103.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libcurl-8.23.0-ha042cf0_0.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libedit-3.1.20260512-pl5321h373387f_0.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libev-4.33-h280c20c_3.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libexpat-2.9.0-hd2095e1_0.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libgcc-16.2.0-ha9f2e26_7.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libgfortran5-16.2.0-h6b99dfc_7.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libgomp-16.2.0-he0feb66_7.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/liblzma-5.8.3-hb03c661_1.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libnghttp2-1.71.0-hc5e5977_0.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libpsl-0.23.1-h7fe8442_2.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libsanitizer-16.2.0-h3048135_7.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libssh2-1.11.1-h6154650_1.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libstdcxx-16.2.0-h934c35e_7.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libuv-1.52.1-h280c20c_1.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libzlib-1.3.2-h25fd6f3_3.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/ncurses-6.6-hdb14827_1.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/ninja-1.13.2-h171cf75_1.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/openssl-3.6.5-h781a0a9_0.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/rhash-1.4.6-hb03c661_2.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/zstd-1.5.7-hb78ec9c_7.conda + - conda: https://conda.anaconda.org/conda-forge/noarch/ca-certificates-2026.10.23-hbd8a1cb_0.conda + - conda: https://conda.anaconda.org/conda-forge/noarch/kernel-headers_linux-64-4.18.0-he073ed8_9.conda + - conda: https://conda.anaconda.org/conda-forge/noarch/libgcc-devel_linux-64-16.2.0-he3ce08f_107.conda + - conda: https://conda.anaconda.org/conda-forge/noarch/libstdcxx-devel_linux-64-16.2.0-h86e191b_107.conda + - conda: https://conda.anaconda.org/conda-forge/noarch/sysroot_linux-64-2.28-h4ee821c_9.conda + - conda: https://conda.anaconda.org/conda-forge/noarch/tzdata-2026e-h5d301ff_0.conda + host_packages: + - conda: https://conda.anaconda.org/conda-forge/linux-64/_openmp_mutex-4.5-20_gnu.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/gsl-2.8-h3cd6761_2.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libblas-3.11.0-12_h4a7cf45_openblas.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libcblas-3.11.0-12_h0358290_openblas.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libgcc-16.2.0-ha9f2e26_7.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libgfortran-16.2.0-h69a702a_7.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libgfortran5-16.2.0-h6b99dfc_7.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libgomp-16.2.0-he0feb66_7.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libopenblas-0.3.34-pthreads_hf13c14d_2.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libopenblas-ilp64-0.3.34-pthreads_h79482e6_2.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/libstdcxx-16.2.0-h934c35e_7.conda + - conda: https://conda.anaconda.org/conda-forge/linux-64/openblas-ilp64-0.3.34-pthreads_h8097de1_2.conda diff --git a/pixi.toml b/pixi.toml new file mode 100644 index 0000000..e7306de --- /dev/null +++ b/pixi.toml @@ -0,0 +1,44 @@ +[workspace] +channels = ["conda-forge"] +platforms = ["linux-64"] +preview = ["pixi-build"] + + +[package] +name = "mess" +version = "2.10.32" + +[package.build.backend] +name = "pixi-build-cmake" +version = "0.*" + +[package.build.config] +compilers = ["c", "cxx", "fortran"] +# MESS needs ILP64 (64-bit integer) BLAS/LAPACK. conda-forge's openblas-ilp64 +# suffixes its symbols with 64_, which MESS_BLAS_SUFFIX maps to. +extra-args = [ + "-DBLAS_LIBRARIES=$PREFIX/lib/libopenblas64_.so", + "-DLAPACK_LIBRARIES=$PREFIX/lib/libopenblas64_.so", + "-DMESS_BLAS_SUFFIX=64_", +] + +[package.host-dependencies] +openblas-ilp64 = "*" # headers and libopenblas64_.so (no run-exports) +libopenblas-ilp64 = "*" # runtime library (run-exports itself) +gsl = "*" + +[tasks] +test = "bash tests/run-examples.sh" + +# Two environments with the same executables: +# default: dynamically linked against conda-forge libraries (this package) +# static: fully static executables, no runtime dependencies (static/recipe.yaml) +[feature.dynamic.dependencies] +mess = { path = "." } + +[feature.static.dependencies] +mess-static = { path = "static" } + +[environments] +default = ["dynamic"] +static = ["static"] diff --git a/static/README.md b/static/README.md index e7f9161..4a89cc0 100644 --- a/static/README.md +++ b/static/README.md @@ -1,23 +1,15 @@ -# Instructions +# mess-static -These instructions show how to build and upload the `mess-static` conda package, -containing the static executables in this directory. -The process relies in the Pixi package manager, which can be installed as follows. -``` -curl -fsSL https://pixi.sh/install.sh | sh -``` +The `mess-static` conda package holds fully static MESS executables (`mess`, `messpf`, `messabs`). +They have no runtime dependencies and run on any x86-64 Linux. +They are built from the repository root with the same `CMakeLists.txt` as the dynamic `mess` package, using `-DMESS_STATIC=ON` (see `recipe.yaml`). -### Build +This directory is a package of the root Pixi workspace. From the repository root: -Build the conda package: ``` -pixi build +pixi run -e static test # build and test the static executables +pixi publish --path static --target-dir dist # build dist/mess-static-*.conda ``` -### Upload - -Upload the conda package: -``` -export ANACONDA_API_KEY= -pixi run upload -``` +The executables are then in `.pixi/envs/static/bin/`. +The GitHub Actions workflow uploads them as a build artifact, and uploads the conda package to the Auto-Mech channel on pushes to `master` of `Auto-Mech/MESS`. diff --git a/static/abstraction b/static/abstraction deleted file mode 100755 index c946132..0000000 Binary files a/static/abstraction and /dev/null differ diff --git a/static/crossrate b/static/crossrate deleted file mode 100755 index f2571e5..0000000 Binary files a/static/crossrate and /dev/null differ diff --git a/static/gumbo b/static/gumbo deleted file mode 100755 index 4307805..0000000 Binary files a/static/gumbo and /dev/null differ diff --git a/static/mess b/static/mess deleted file mode 100755 index a427a6a..0000000 Binary files a/static/mess and /dev/null differ diff --git a/static/mess_mpi b/static/mess_mpi deleted file mode 100755 index aa5fc98..0000000 Binary files a/static/mess_mpi and /dev/null differ diff --git a/static/partition_function b/static/partition_function deleted file mode 100755 index effaa47..0000000 Binary files a/static/partition_function and /dev/null differ diff --git a/static/pixi.lock b/static/pixi.lock deleted file mode 100644 index c44093b..0000000 --- a/static/pixi.lock +++ /dev/null @@ -1,228 +0,0 @@ -version: 6 -environments: - default: - channels: - - url: https://prefix.dev/conda-forge/ - options: - pypi-prerelease-mode: if-necessary-or-explicit - packages: - linux-64: - - conda: . - osx-64: - - conda: . - osx-arm64: - - conda: . - win-64: - - conda: . - dev: - channels: - - url: https://prefix.dev/conda-forge/ - options: - pypi-prerelease-mode: if-necessary-or-explicit - packages: - linux-64: - - conda: https://prefix.dev/conda-forge/linux-64/_libgcc_mutex-0.1-conda_forge.tar.bz2 - - conda: https://prefix.dev/conda-forge/linux-64/_openmp_mutex-4.5-2_gnu.tar.bz2 - - conda: https://prefix.dev/conda-forge/noarch/ca-certificates-2025.8.3-hbd8a1cb_0.conda - - conda: https://prefix.dev/conda-forge/linux-64/libgcc-15.1.0-h767d61c_5.conda - - conda: https://prefix.dev/conda-forge/linux-64/libgomp-15.1.0-h767d61c_5.conda - - conda: https://prefix.dev/conda-forge/linux-64/libstdcxx-15.1.0-h8f9b012_5.conda - - conda: https://prefix.dev/conda-forge/linux-64/openssl-3.5.3-h26f9b46_1.conda - - conda: https://prefix.dev/conda-forge/linux-64/patchelf-0.18.0-h3f2d84a_2.conda - - conda: https://prefix.dev/conda-forge/linux-64/rattler-build-0.47.0-h60886be_0.conda - - conda: . - osx-64: - - conda: https://prefix.dev/conda-forge/osx-64/rattler-build-0.47.0-h9113d71_0.conda - - conda: . - osx-arm64: - - conda: https://prefix.dev/conda-forge/osx-arm64/rattler-build-0.47.0-h8d80559_0.conda - - conda: . - win-64: - - conda: https://prefix.dev/conda-forge/win-64/rattler-build-0.47.0-h18a1a76_0.conda - - conda: https://prefix.dev/conda-forge/win-64/ucrt-10.0.26100.0-h57928b3_0.conda - - conda: https://prefix.dev/conda-forge/win-64/vc-14.3-h41ae7f8_31.conda - - conda: https://prefix.dev/conda-forge/win-64/vc14_runtime-14.44.35208-h818238b_31.conda - - conda: https://prefix.dev/conda-forge/win-64/vcomp14-14.44.35208-h818238b_31.conda - - conda: . -packages: -- conda: https://prefix.dev/conda-forge/linux-64/_libgcc_mutex-0.1-conda_forge.tar.bz2 - sha256: fe51de6107f9edc7aa4f786a70f4a883943bc9d39b3bb7307c04c41410990726 - md5: d7c89558ba9fa0495403155b64376d81 - license: None - size: 2562 - timestamp: 1578324546067 -- conda: https://prefix.dev/conda-forge/linux-64/_openmp_mutex-4.5-2_gnu.tar.bz2 - build_number: 16 - sha256: fbe2c5e56a653bebb982eda4876a9178aedfc2b545f25d0ce9c4c0b508253d22 - md5: 73aaf86a425cc6e73fcf236a5a46396d - depends: - - _libgcc_mutex 0.1 conda_forge - - libgomp >=7.5.0 - constrains: - - openmp_impl 9999 - license: BSD-3-Clause - license_family: BSD - size: 23621 - timestamp: 1650670423406 -- conda: https://prefix.dev/conda-forge/noarch/ca-certificates-2025.8.3-hbd8a1cb_0.conda - sha256: 837b795a2bb39b75694ba910c13c15fa4998d4bb2a622c214a6a5174b2ae53d1 - md5: 74784ee3d225fc3dca89edb635b4e5cc - depends: - - __unix - license: ISC - size: 154402 - timestamp: 1754210968730 -- conda: https://prefix.dev/conda-forge/linux-64/libgcc-15.1.0-h767d61c_5.conda - sha256: 0caed73aac3966bfbf5710e06c728a24c6c138605121a3dacb2e03440e8baa6a - md5: 264fbfba7fb20acf3b29cde153e345ce - depends: - - __glibc >=2.17,<3.0.a0 - - _openmp_mutex >=4.5 - constrains: - - libgomp 15.1.0 h767d61c_5 - - libgcc-ng ==15.1.0=*_5 - license: GPL-3.0-only WITH GCC-exception-3.1 - license_family: GPL - size: 824191 - timestamp: 1757042543820 -- conda: https://prefix.dev/conda-forge/linux-64/libgomp-15.1.0-h767d61c_5.conda - sha256: 125051d51a8c04694d0830f6343af78b556dd88cc249dfec5a97703ebfb1832d - md5: dcd5ff1940cd38f6df777cac86819d60 - depends: - - __glibc >=2.17,<3.0.a0 - license: GPL-3.0-only WITH GCC-exception-3.1 - license_family: GPL - size: 447215 - timestamp: 1757042483384 -- conda: https://prefix.dev/conda-forge/linux-64/libstdcxx-15.1.0-h8f9b012_5.conda - sha256: 0f5f61cab229b6043541c13538d75ce11bd96fb2db76f94ecf81997b1fde6408 - md5: 4e02a49aaa9d5190cb630fa43528fbe6 - depends: - - __glibc >=2.17,<3.0.a0 - - libgcc 15.1.0 h767d61c_5 - license: GPL-3.0-only WITH GCC-exception-3.1 - license_family: GPL - size: 3896432 - timestamp: 1757042571458 -- conda: . - name: mess-static - version: 2026.2.4 - build: h4616a5c_0 - subdir: noarch - variants: - target_platform: noarch -- conda: https://prefix.dev/conda-forge/linux-64/openssl-3.5.3-h26f9b46_1.conda - sha256: 0572be1b7d3c4f4c288bb8ab1cb6007b5b8b9523985b34b862b5222dea3c45f5 - md5: 4fc6c4c88da64c0219c0c6c0408cedd4 - depends: - - __glibc >=2.17,<3.0.a0 - - ca-certificates - - libgcc >=14 - license: Apache-2.0 - license_family: Apache - size: 3128517 - timestamp: 1758597915858 -- conda: https://prefix.dev/conda-forge/linux-64/patchelf-0.18.0-h3f2d84a_2.conda - sha256: 2f1caf273c7816fcff6e8438138c29d08264f8371dc0e23f86e993ccc7e978dc - md5: 5a6bde274af5252392b446ead19047d0 - depends: - - __glibc >=2.17,<3.0.a0 - - libgcc >=13 - - libstdcxx >=13 - - libgcc >=13 - license: GPL-3.0-or-later - license_family: GPL - size: 136130 - timestamp: 1745559387060 -- conda: https://prefix.dev/conda-forge/linux-64/rattler-build-0.47.0-h60886be_0.conda - sha256: aa71bcaf81c71da4a9137777249970c426a37afd46b7960b3e8c397f553a7f40 - md5: 98366f1ada223a785f0dc24ed211a99c - depends: - - patchelf - - libgcc >=14 - - __glibc >=2.17,<3.0.a0 - - openssl >=3.5.2,<4.0a0 - constrains: - - __glibc >=2.17 - license: BSD-3-Clause - license_family: BSD - size: 16827195 - timestamp: 1756921257075 -- conda: https://prefix.dev/conda-forge/osx-64/rattler-build-0.47.0-h9113d71_0.conda - sha256: 03d8c45aec0e1d8e4485a54e7e61e464ecc4752c1ec6e8fdd5458c226988eba8 - md5: b2f5ad0a287f0712c23abb0f45fbce6d - depends: - - __osx >=10.13 - constrains: - - __osx >=10.13 - license: BSD-3-Clause - size: 15200171 - timestamp: 1756921285627 -- conda: https://prefix.dev/conda-forge/osx-arm64/rattler-build-0.47.0-h8d80559_0.conda - sha256: d747d7d36bd38d37f6e80cb78358c373fb5776147e21f9da4121e736f9212796 - md5: dd3bf0dde45e18b8644b97a401f08ba2 - depends: - - __osx >=11.0 - constrains: - - __osx >=11.0 - license: BSD-3-Clause - license_family: BSD - size: 14273395 - timestamp: 1756921328894 -- conda: https://prefix.dev/conda-forge/win-64/rattler-build-0.47.0-h18a1a76_0.conda - sha256: 30e17e3741a7d98b937198cf2f4e6eedbadac9ecb0725334c63e2960cd5a5bc3 - md5: c8e0123a1fdee1980eff4ea01fbaac88 - depends: - - vc >=14.3,<15 - - vc14_runtime >=14.44.35208 - - ucrt >=10.0.20348.0 - - vc >=14.3,<15 - - vc14_runtime >=14.44.35208 - - ucrt >=10.0.20348.0 - license: BSD-3-Clause - license_family: BSD - size: 17784676 - timestamp: 1756921275818 -- conda: https://prefix.dev/conda-forge/win-64/ucrt-10.0.26100.0-h57928b3_0.conda - sha256: 3005729dce6f3d3f5ec91dfc49fc75a0095f9cd23bab49efb899657297ac91a5 - md5: 71b24316859acd00bdb8b38f5e2ce328 - constrains: - - vc14_runtime >=14.29.30037 - - vs2015_runtime >=14.29.30037 - license: LicenseRef-MicrosoftWindowsSDK10 - size: 694692 - timestamp: 1756385147981 -- conda: https://prefix.dev/conda-forge/win-64/vc-14.3-h41ae7f8_31.conda - sha256: cb357591d069a1e6cb74199a8a43a7e3611f72a6caed9faa49dbb3d7a0a98e0b - md5: 28f4ca1e0337d0f27afb8602663c5723 - depends: - - vc14_runtime >=14.44.35208 - track_features: - - vc14 - license: BSD-3-Clause - license_family: BSD - size: 18249 - timestamp: 1753739241465 -- conda: https://prefix.dev/conda-forge/win-64/vc14_runtime-14.44.35208-h818238b_31.conda - sha256: af4b4b354b87a9a8d05b8064ff1ea0b47083274f7c30b4eb96bc2312c9b5f08f - md5: 603e41da40a765fd47995faa021da946 - depends: - - ucrt >=10.0.20348.0 - - vcomp14 14.44.35208 h818238b_31 - constrains: - - vs2015_runtime 14.44.35208.* *_31 - license: LicenseRef-MicrosoftVisualCpp2015-2022Runtime - license_family: Proprietary - size: 682424 - timestamp: 1753739239305 -- conda: https://prefix.dev/conda-forge/win-64/vcomp14-14.44.35208-h818238b_31.conda - sha256: 67b317b64f47635415776718d25170a9a6f9a1218c0f5a6202bfd687e07b6ea4 - md5: a6b1d5c1fc3cb89f88f7179ee6a9afe3 - depends: - - ucrt >=10.0.20348.0 - constrains: - - vs2015_runtime 14.44.35208.* *_31 - license: LicenseRef-MicrosoftVisualCpp2015-2022Runtime - license_family: Proprietary - size: 113963 - timestamp: 1753739198723 diff --git a/static/pixi.toml b/static/pixi.toml index f947de9..975748e 100644 --- a/static/pixi.toml +++ b/static/pixi.toml @@ -1,22 +1,12 @@ -[workspace] -channels = ["https://prefix.dev/conda-forge"] -platforms = ["osx-arm64", "osx-64", "linux-64", "win-64"] -preview = ["pixi-build"] - -[dependencies] -mess-static = { path = "." } +# Fully static MESS executables, built from the repository root with -DMESS_STATIC=ON. +# This is a package of the root workspace (see ../pixi.toml). +# It uses the rattler-build backend so that recipe.yaml can drop the run-exports +# of its build and host dependencies: the package has no runtime dependencies. [package] name = "mess-static" +version = "2026.11.0" -[package.build] -backend = { name = "pixi-build-rattler-build", version = "0.3.*" } - -[feature.dev.dependencies] -rattler-build = "*" - -[feature.dev.tasks] -upload = "rattler-build upload anaconda -o Auto-Mech *.conda" - -[environments] -dev = ["dev"] +[package.build.backend] +name = "pixi-build-rattler-build" +version = "0.*" diff --git a/static/recipe.yaml b/static/recipe.yaml index 93786fe..11c5b77 100644 --- a/static/recipe.yaml +++ b/static/recipe.yaml @@ -1,15 +1,53 @@ package: name: mess-static - version: "2026.2.4" + version: "2026.11.0" source: - path: . + path: .. + use_gitignore: true build: - noarch: generic - script: - - mkdir -p ${PREFIX}/bin - - cp ${RECIPE_DIR}/mess ${PREFIX}/bin/mess - - cp ${RECIPE_DIR}/abstraction ${PREFIX}/bin/messabs - - cp ${RECIPE_DIR}/partition_function ${PREFIX}/bin/messpf - - cp ${RECIPE_DIR}/gumbo ${PREFIX}/bin/gumbo + number: 0 + # Fully static executables: nothing to relocate, no runtime dependencies. + dynamic_linking: + binary_relocation: false + script: | + cmake $CMAKE_ARGS -GNinja -S . -B ../build \ + -DCMAKE_BUILD_TYPE=Release \ + -DMESS_STATIC=ON \ + -DBLAS_LIBRARIES=$PREFIX/lib/libopenblas64_.a \ + -DLAPACK_LIBRARIES=$PREFIX/lib/libopenblas64_.a + cmake --build ../build --target install + +requirements: + build: + - ${{ compiler('c') }} + - ${{ compiler('cxx') }} + - ${{ compiler('fortran') }} + - ${{ stdlib('c') }} + - cmake + - ninja + host: + # The static archive libopenblas64_.a keeps the unsuffixed (ILP64) names, + # so no MESS_BLAS_SUFFIX here. + - openblas-ilp64 + - gsl + ignore_run_exports: + by_name: + - libgcc + - libstdcxx + - libgfortran + - libgfortran5 + - libgomp + - gsl + - libopenblas-ilp64 + +tests: + - script: + - test -x $PREFIX/bin/mess + - "! ldd $PREFIX/bin/mess" + +about: + homepage: https://github.com/Auto-Mech/MESS + license: Apache-2.0 + summary: MESS (Master Equation System Solver), fully static executables diff --git a/tests/reference/mess.out b/tests/reference/mess.out new file mode 100644 index 0000000..90d9d39 --- /dev/null +++ b/tests/reference/mess.out @@ -0,0 +1,175 @@ +Wells (G - ground energy, D - dissociation limit, kcal/mol): + W G D + W1 -99.1 0 + +Bimolecular Products (G - ground energy, kcal/mol): + P G + P1 0 + +Well-to-Bimolecular Barriers (H/G - barrier height/well depth, kcal/mol) + B H W G P + B1 0 W1 -99.1 P1 + +Bound Groups: dissociation barrier (name/ground energy, kcal/mol): wells (name/ground energy, kcal/mol): + B1/0: W1/-99.1 + +________________________________________________________________________________________ + +Unimolecular Rate Units: 1/sec; Bimolecular Rate Units: cm^3/sec + +______________________________________________________________________________________ + +Species-Species Rate Tables: + +Temperature = 100 K + +High Pressure Rate Coefficients: + +From\To W1 P1 +W1 *** *** +P1 1.69e-10 *** + +Temperature = 100 K Pressure = 0.1 bar + +From\To W1 P1 +W1 *** *** +P1 1.67e-10 1.67e-10 + +Temperature = 100 K Pressure = 1 bar + +From\To W1 P1 +W1 *** *** +P1 1.69e-10 1.69e-10 + +Temperature = 200 K + +High Pressure Rate Coefficients: + +From\To W1 P1 +W1 *** *** +P1 1.79e-10 *** + +Temperature = 200 K Pressure = 0.1 bar + +From\To W1 P1 +W1 *** *** +P1 1.51e-10 1.51e-10 + +Temperature = 200 K Pressure = 1 bar + +From\To W1 P1 +W1 *** *** +P1 1.75e-10 1.75e-10 + +______________________________________________________________________________________ + +High Pressure Rate Coefficients (Temperature-Species Rate Tables): + +Reactant = W1 + T(K) W1 P1 + 100 *** *** + 200 *** *** + +Reactant = P1 + T(K) W1 P1 + 100 1.69e-10 *** + 200 1.79e-10 *** + +Capture/Escape Rate Coefficients: + + T(K) W1 P1 + 100 *** 1.69e-10 + 200 *** 1.79e-10 + +______________________________________________________________________________________ + +Pressure-Species Rate Tables: + +Reactant = W1 Temperature = 100 K + + P(bar) P1 Loss + 0.1 *** *** + 1 *** *** + O-O *** *** + +Reactant = W1 Temperature = 200 K + + P(bar) P1 Loss + 0.1 *** *** + 1 *** *** + O-O *** *** + +Reactant = P1 Temperature = 100 K + + P(bar) W1 Loss + 0.1 1.67e-10 1.67e-10 + 1 1.69e-10 1.69e-10 + O-O 1.69e-10 1.69e-10 + +Reactant = P1 Temperature = 200 K + + P(bar) W1 Loss + 0.1 1.51e-10 1.51e-10 + 1 1.75e-10 1.75e-10 + O-O 1.79e-10 1.79e-10 + +______________________________________________________________________________________ + +Temperature-Species Rate Tables: + +Reactant = W1 Pressure = 0.1 bar + + T(K) P1 Loss Capture + 100 *** *** *** + 200 *** *** *** + +Reactant = W1 Pressure = 1 bar + + T(K) P1 Loss Capture + 100 *** *** *** + 200 *** *** *** + +Reactant = P1 Pressure = 0.1 bar + + T(K) W1 Loss Capture + 100 1.67e-10 1.67e-10 1.69e-10 + 200 1.51e-10 1.51e-10 1.79e-10 + +Reactant = P1 Pressure = 1 bar + + T(K) W1 Loss Capture + 100 1.69e-10 1.69e-10 1.69e-10 + 200 1.75e-10 1.75e-10 1.79e-10 + +______________________________________________________________________________________ + +Temperature-Pressure Rate Tables: + +W1->P1 + +P\T 100 200 +0.1 *** *** +1 *** *** +O-O *** *** + +P1->W1 + +P\T 100 200 +0.1 1.67e-10 1.51e-10 +1 1.69e-10 1.75e-10 +O-O 1.69e-10 1.79e-10 + +W1-> + +P\T 100 200 +0.1 *** *** +1 *** *** +O-O *** *** + +P1-> + +P\T 100 200 +0.1 1.67e-10 1.51e-10 +1 1.69e-10 1.75e-10 +O-O 1.69e-10 1.79e-10 + diff --git a/tests/reference/messabs.out b/tests/reference/messabs.out new file mode 100644 index 0000000..0421f42 --- /dev/null +++ b/tests/reference/messabs.out @@ -0,0 +1,30 @@ +Rate Units: cm^3/sec + + T, K P1->P2 P2->P1 + 200 6.73358e-16 *** + 250 1.45114e-15 *** + 300 3.22023e-15 *** + 400 1.43294e-14 *** + 500 4.87102e-14 *** + 600 1.28613e-13 *** + 700 2.8072e-13 *** + 800 5.33258e-13 *** + 900 9.14073e-13 *** + 1000 1.44947e-12 *** + 1100 2.16356e-12 *** + 1200 3.07793e-12 *** + 1300 4.21153e-12 *** + 1400 5.58072e-12 *** + 1500 7.19936e-12 *** + 1625 9.59091e-12 *** + 1750 1.24083e-11 *** + 1875 1.56651e-11 *** + 2000 1.93713e-11 *** + 2125 2.35336e-11 *** + 2250 2.8156e-11 *** + 2375 3.32404e-11 *** + 2500 3.87869e-11 *** + 2625 4.47943e-11 *** + 2750 5.126e-11 *** + 2875 5.81806e-11 *** + 3000 6.55519e-11 *** diff --git a/tests/reference/messpf.dat b/tests/reference/messpf.dat new file mode 100644 index 0000000..2bdc243 --- /dev/null +++ b/tests/reference/messpf.dat @@ -0,0 +1,34 @@ +Natural log of the partition function, its derivatives, entropy, and thermal capacity: +T, K CH4O CH4O CH4O CH4O CH4O + Z_0 Z_1 Z_2 S, cal/mol/K C, cal/mol/K +100 60.1983 0.0302761 -0.000290427 36.7305 8.24871 +200 62.3581 0.0163207 -6.51731e-05 42.8699 9.77968 +300 63.7557 0.0123154 -2.28447e-05 47.3084 12.5854 +400 64.9053 0.0109421 -6.74453e-06 51.5204 17.238 +500 65.9811 0.010705 1.21039e-06 56.0404 23.8613 +600 67.0664 0.0110813 5.9895e-06 61.1354 32.6968 +700 68.2106 0.011859 9.42064e-06 66.9994 44.1529 +800 69.4485 0.0129453 1.22352e-05 73.8081 58.7076 +900 70.8085 0.014296 1.47438e-05 81.733 76.8553 +1000 72.3157 0.0158886 1.70879e-05 90.9433 99.0917 +1100 73.9938 0.0177105 1.93376e-05 101.607 125.912 +1200 75.8652 0.0197543 2.15298e-05 113.892 157.809 +1300 77.9519 0.0220153 2.36856e-05 127.964 195.278 +1400 80.2754 0.0244906 2.58173e-05 143.99 238.812 +1500 82.8571 0.0271782 2.79324e-05 162.135 288.903 +1600 85.7181 0.0300767 3.00358e-05 182.566 346.043 +1700 88.8794 0.033185 3.21303e-05 205.446 410.724 +1800 92.3621 0.0365025 3.4218e-05 230.941 483.435 +1900 96.1869 0.0400285 3.63002e-05 259.216 564.664 +2000 100.375 0.0437624 3.83778e-05 290.434 654.9 +2100 104.946 0.0477039 4.04514e-05 324.76 754.63 +2200 109.922 0.0518526 4.25216e-05 362.358 864.341 +2300 115.324 0.0562081 4.45887e-05 403.391 984.517 +2400 121.171 0.0607702 4.6653e-05 448.023 1115.65 +2500 127.485 0.0655386 4.87146e-05 496.416 1258.21 +2600 134.285 0.0705131 5.07739e-05 548.734 1412.69 +2700 141.594 0.0756933 5.2831e-05 605.139 1579.58 +2800 149.431 0.0810792 5.4886e-05 665.795 1759.36 +2900 157.817 0.0866705 5.6939e-05 730.862 1952.51 +3000 166.772 0.0924669 5.89903e-05 800.504 2159.51 +298.2 63.7335 0.0123569 -2.32761e-05 47.2329 12.5191 diff --git a/tests/run-examples.sh b/tests/run-examples.sh new file mode 100755 index 0000000..fe4b6cf --- /dev/null +++ b/tests/run-examples.sh @@ -0,0 +1,51 @@ +#!/usr/bin/env bash +# Run the MESS executables on examples/ and compare their output with tests/reference/. +# The reference outputs come from the upstream static binaries. +# Usage: tests/run-examples.sh [RTOL] (default relative tolerance 1e-6) +set -euo pipefail + +root="$(cd "$(dirname "$0")/.." && pwd)" +rtol="${1:-1e-6}" +work="$(mktemp -d)" +trap 'rm -rf "$work"' EXIT +cp -r "$root/examples/." "$work/" +cd "$work" + +# Compare two files token by token: numbers within rtol, everything else exactly. +compare() { + awk -v rtol="$rtol" -v name="$1" ' + function isnum(x) { return x ~ /^[-+]?([0-9]+\.?[0-9]*|\.[0-9]+)([eE][-+]?[0-9]+)?$/ } + NR == FNR { ref[FNR] = $0; nref = FNR; next } + { + n = split(ref[FNR], a); m = split($0, b) + if (n != m) { printf "%s:%d: token count differs\n", name, FNR; bad = 1; next } + for (i = 1; i <= n; i++) { + if (isnum(a[i]) && isnum(b[i])) { + d = a[i] - b[i]; if (d < 0) d = -d + s = (a[i] < 0 ? -a[i] : a[i]); t = (b[i] < 0 ? -b[i] : b[i]); if (t > s) s = t + if (d > rtol * s) { printf "%s:%d: %s vs %s\n", name, FNR, a[i], b[i]; bad = 1 } + } else if (a[i] != b[i]) { printf "%s:%d: \"%s\" vs \"%s\"\n", name, FNR, a[i], b[i]; bad = 1 } + } + } + END { if (FNR != nref) { printf "%s: line count differs\n", name; bad = 1 }; exit bad } + ' "$root/tests/reference/$1" "$1" +} + +status=0 +run() { # run + echo "== $1 $2" + if ! "$1" "$2" > "$1.stdout" 2>&1; then + echo "FAIL: $1 exited with an error"; tail -5 "$1.stdout"; status=1; return + fi + if [ ! -s "$3" ]; then echo "FAIL: $3 is missing or empty"; status=1; return; fi + if compare "$3"; then echo "ok"; else echo "FAIL: $3 differs from tests/reference/$3"; status=1; fi +} + +run mess mess.inp mess.out +run messpf messpf.inp messpf.dat +run messabs messabs.inp messabs.out + +if [ "$status" -ne 0 ] && [ -n "${MESS_TEST_KEEP:-}" ]; then + mkdir -p "$MESS_TEST_KEEP" && cp -r "$work/." "$MESS_TEST_KEEP/" +fi +exit "$status"